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Mask/Regulator  Model  Cmnputer  Program 


PROGRAM  MASKMODL 
c«  •  • 

C.  V.  MOOUN  NASXNOOL  CALLS:  (1)  SUBROUTINE  INITIAL  TO  DEFINE  THE  ODE 
C...  INITIAL  CONDITIONS,  (2)  SUBROUTINE  RKF45  TO  INTEGRATE  THE  ODES, 

C...  AND  (3)  SUBROUTINE  PRINT  TO  PRINT  THE  SOLUTION. 

C..'.  THE  FOLLOWING  COOING  IS  FOR  500  ODES.  IF  MORE  DOES  ARE  TO  BE  INTE- 
C...  GRATED,  ALL  OF  THE  500'S  SHOULD  IE  CHANGED  TO  THE  REQUIRED  NUNBER 
INPLICIT  DOUBLE  PRECISION  (A-H>,  DOUBLE  PRECISION  (0-Z) 

INTEGER  NI,  NO,  NEON,  NSTOP,  NORUN 
CONNON/T/  T,  XT,  NSTOP,  NORUN 

1  /Y/  y<500) 

2  /F/  F<500) 

c!!!  THE  NUNBER  OF  DIFFERENTIAL  EQUATIONS  IS  IN  CONNON/N/  FOR  USE  IN 
C...  SUBROUTINE  FCN 

COMNON/N/  NEON 

C... 

C...  CONNOR  AREA  TO  PROVIDE  THE  INPUT/OUTPUT  UNIT  NUHBERS  TO  OTHER 
C...  SUBROUTINES 

CONNON/IO/  NI,  NO 

C... 

C...  ABSOLUTE  DINENSIONIHG  OF  THE  ARRAYS  REQUIRED  BY  RKF4S 
DOUBLE  PRECISION  YV(SOO),  UORKC 11000) 

INTEGER  IU0RK(5) 

C... 

C...  EXTERNAL  THE  DERIVATIVE  ROUTINE  CALLED  BY  RKF4S 
EXTERNAL  FCN 

C... 

C...  ARRAY  FOR  THE  TITLE  (FIRST  LINE  OF  DATA),  CHARACTERS  END  OF  RUNS 
CHARACTER  TITLE(20)*4,  EN0RUN(3)*4 

C... 

C...  DEFINE  THE  CHARACTERS  END  OF  RUNS 
DATA  ENDRUN/'END  ','OF  R'.'UNS  '/ 

C.V.  DEFINE  THE  INPUT/OUTPUT  UNIT  NUNBERS 
NI-5 
NO^ 

C... 

C...  OPEN  INPUT  AND  OUTPUT  FILES 
OPEN(NI , F I LE>' NASKDAT .DAT ' ) 

OPEN(NO, FILE>'OUTPUT.PRN' ,BLOCKSIZE-2048) 

C... 

C...  INITIALIZE  THE  RUN  COUNTER 

NQRUN>0 

C... 

C...  BEGIN  A  RUN 

1  NORUN-NORUN+1 
C... 

C...  INITIALIZE  THE  RUN  TERNINATION  VARIABLE 
NST0P«0 

C... 

C...  READ  THE  FIRST  LINE  OF  DATA 
C... 

REAO(NI,1000,ENO*999)  (TITLE(I),  I  «  1,  20) 

C... 

C...  TEST  FOR  END  OF  RUNS  IN  THE  DATA 
C... 

DO  2  I  >  1.  3 

IF(TITLE(I)  .NE.  EM)RUN(I))  GO  TO  3 

2  .  CONTINUE 
C... 

C...  AN  END  OF  RUNS  HAS  BEEN  READ,  SO  TERMINATE  EXECUTION 
999  STOP 
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Prosram  MASKMAIN.FOR 


HAD  THE  SECONO  LINE  OF  DATA 
ltEAD(NI.*,END-999)  TO,  TF,  TP 
HEAD  TNE  TNIED  LINE  OF  DATA 
READ(NI,*,END>999>  NEON.  ERROR 
PRINT  A  DATA  SUMNART 

HRITE(N0.1003)NORUN,(TITLE(I).  I  -  1,  20), 

1  TO,  TF,  TP, 

2  NEON.  ERROR 
«ITE(*,1003)  NORUN,  (TITLE(I),  I  >  1.  20). 

1  TO.  TF.  TP. 

2  NEON.  ERROR 


...  INITIALIZE  TINE 
T  •  TO 

!!  SET  THE  INITIAL  CONDITIONS 
CALL  INITIAL 

!*.  SET  TNE  INITIAL  DERIVATIVES  (FOR  POSSIBLE  PRINTING) 

CALL  OERV 

!!  PRINT  THE  INITIAL  CONDITIONS 
CALL  PRINT(NI,  HO) 

!!  SET  TNE  INITIAL  CONDITIONS  FOR  SUBROUTINE  RKF45 
TV  ■  TO 

DO  5  I  >  1.  NEON 

rvd)  ■  r<i) 

CONTINUE 

!!!  SET  TNE  PARAMETERS  FOR  SUBROUTINE  RKF45 

RELERR  >  ERROR 
ABSERR  >  ERROR 
IFLA6  >  1 
TOUT  «  TO  ♦  TP 

!!!  CALL  SUBROUTINE  RKF45  TO  START  THE  SOLUTION  FROM  THE  INITIAL 
...  OONOITIOM  (IFLAG  ■  1)  OR  COMPUTE  THE  SOLUTION  TO  THE  NEXT  PRINT 
...  POINT  (IFLAG  >  2) 

CALL  RKF45(FCN, NEON, YV.TV.TOUT, RELERR, ABSERR, IFUG.UORK.IUORK) 

!!!  PRINT  THE  SOLUTION  AT  THE  NEXT  PRINT  POINT 
T«TV 

TOOT  •  TV  ♦  TP 
PRINT  *,"Tli»  ■  T 
DO  6  I  •  1,  NEON 
Yd)  •  YVd) 

CONTINUE 

CALL  OERV 

CALL  PR1NT(NI,N0) 

IFdFLAG  .EO.  4  .OR.  IFLAG  .EO.  7)  IFLAG  =  2 

!!!  TEST  FOR  AN  ERROR  CONDITION 
IFdFLAG  .me.  2)  THEN 

PRINT  A  MESSAGE  IHDIUTING  AN  ERROR  CONDITION 
URITE(NO,10O4)  I  FUG 

C... 
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Program  MASKMAIN.FOR 


C...  00  ON  TO  THE  HEXT  RUN 

00  TO  1 
END  IF 

C... 

C...  CHECK  FOR  A  RUN  TERMINATION 
IF(NtTOP  .NE.  0}  CO  TO  1 

C... 

C...  CHECK  FOR  THE  ENO  OF  THE  RUN 
C... 

IF(TV  .LT.  <TF  -  0.500*TP»  00  TO  4 

C... 

C...  THE  CURRENT  RUN  IS  COMPLETE,  SO  GO  ON  TO  THE  NEXT  RUN 
00  TO  1 

C... 

C...  . . . 

C... 

C. . .  FORMATS 
C... 

1000  F0RMAT(20A4} 

1001  FORMAT(3C10.0) 

1002  F0RMAT(I5,20X.E10.0) 

100S  FORHATdHI, 

1  '  RUM  NO.  -  '.IS,2X,20A4.//, 

2  '  INITIAL  T  -  ',E10.3,//, 

3  '  FINAL  T  •  »,E10.3,//, 

4  •  PRINT  T  •  '.E10.3,//, 

5  '  NUMBER  OF  DIFFERENTIAL  NUATtONS  -  '.15,//, 

A  '  MAXIMUM  INTEGRATION  ERROR  •  ',E10.3.//. 

7  INI) 

1004  F0RNAT<1H  ,//,'  IFLAG  «  ',13,//. 

1  '  INDICATING  AN  INTEGRATION  ERROR.  SO  THE  CURRENT  RUN'  ,/, 

2  '  IS  TERMINATED.  PLEASE  REFER  TO  THE  DOCUMENTATION  FOR'  ,/, 

3  '  SUBR0UriMC',//,2SX,'RKF45',//, 

4  '  FOR  AN  EXPLANATION  OF  THESE  ERROR  INDICATORS'  ) 

END 

SUBROUTINE  FCN(TV,YV,TDOT) 

C. . . 

C...  SUEROUTINE  FCN  IS  AN  INTERFACE  ROUTINE  BETWEEN  SUBROUTINES  RKF45 
C...  AMO  DERV 
C. . . 

C.V.  NOTE  THAT  THE  SITE  OF  ARRArS  T  AND  F  IN  THE  FOLLOWING  COMMON  AREA 
C...  IS  ACTUALLT  SET  BY  THE  CORRESPONDING  COMMON  STATEMENT  IN  MAIN 
C...  PROGRAM  HEADHIT 

IMPLICIT  DOUBLE  PRECISION  <A-H},  DOUBLE  PRECISION  (0-Z) 

INTEGER  NEON,  NSTOP,  NORUN 

COMNOH/T/  T,  XT,  NSTOP,  MRUN 

1  /Y/  r<500) 

2  /F/  F<500) 

C. . . 

c!.!  THE  NUMBER  OF  DIFFERENTIAL  EQUATIONS  IS  AVAILABLE  THROUGH  COMMON 
C...  /N/ 

C... 

COMNON/N/  NEON 

C... 

C...  ABSOLUTE  DIMENSION  THE  OEPCHOENT  VARIABLE,  DERIVATIVE  VECTORS 
DOUBLE  PRECISION  YVISOO),  YOOT(SOO) 

C. . . 

c!!!  TRANSFER  THE  INDEPENDENT  VARIABLE.  DEPENDENT  VARIABLE  VECTOR 

C...  FOR  USE  IN  SUBROUTINE  DERV 

C... 

T  «  TV 

DO  1  I  >  1,  NEON 
Yd)  »  YVd) 

1  CONTINUE 
C... 
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ProgrMi  MA8KMAIN.FOR 


...  EVALUATE  THE  OEEIVATIVE  VECTOA 
CALL  OEEV 

TtANSFEE  THE  DERIVATIVE  VECTOR  FOR  USE  BT  SUBROUTINE  RKF4S 

DO  2  I  -  1,  NEON 
TDOT(I)  -  F(l) 

2  CONTINUE 
RETURN 
END 
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Proaram  MASKSUBS.FOR 


C...  DECK  NASKMS.FOR  -  tUtMUTINES  REQUIRED  TO  IMPLEMENT  A  MODEL  OF  AN 
C...  AVIATOR'S  ORONASAL  MASK. 

C... 

SUMKUTINE  INITIAL 

Suaroutlnt  Initial  aats  Initial  conditlona  and  definaa  conatanta 
paaaad  to  othar  aodulaa  In  COMMON.  It  la  only  called  once. 

...  DETAILED  EXPLANATION  OF  THE  EQUATIONS. 


...  NOTE:  The  aubacript  notation  Indlcatad  partial  darivativa  URT  the 
aubacript  E.G.  Xt  The  firat  partial  darivativa  of  X 
URT  tla». 

Thla  andal  aatiaataa  tha  flow  and  praaaura  within  the  aaak  hoaa  and 
tha  oronaaal  cavity  of  tha  aviator'a  braathlng  naak  during  tha 
breathing  cycle.  Tha  forcing  fwctlon  for  tha  model  ia  tha  voluaa 
changa  ganarated  by  tha  lung  during  braathlng  and  praaaura  changaa. 

Tha  praaant  coding  andala  tha  lung  voluaa  change  by  the  following 
alnuaoidal  function. 

V(t)  a  VLO  *  aaax/w*(C05(Ht)  -  1),  ao  that  the  lung  flow  la 
Qft)  a  aaax*SIN(wt). 

Tha  airway  raalatancaa  ara  modelad  by  alapla  quadratic  fita  to 
..  phyalologic  data.  Tha  raalatanca  of  tha  bronchi  and  trachea  ara 

included  in  tha  lung  model,  but  tha  raalatanca  of  tha  oronaaal  cavity 
la  Included  In  tha  aaak  aoAl  for  convenlanca.  The  oronaaal  reala* 

..  tancaa  ara  accomtad  for  aaparataly  for  tha  noaa  and  mouth  by  tha 
..  following  modal. 

dal  tap  •  K1*0  *  K2nr2 

a  a 

Tha  laat  tarm  in  tha  above  aecocatta  for  inertanca. 

a  a 

For  tha  mouth, 

K1  s  2.4  cm*H20*aac/litar  and  IC2  *  0.3  cm-H20*sec^2/lIter‘'2. 

For  tha  noaa  thara  ara  aaparata  K2's  for  Inspiration  and 
..  expiration. 

K1  >  3.0  cm-H20*aac/litar  and 

Inepiratory  K2  ■  3.0  cm-H20*sac*2/liter'‘2. 

Expiratory  K2  >  4.0  cahH2Q*sec^2/litcr''2. 

Tha  overall  presaura  drop  produced  by  tha  oronasal  cavity 
la  modelled  by  aaeigning  the  relative  fraction  of  the  total  breathing 
flow  to  tha  mouth  and  noaa  raapectively.  Tha  individual  drops  are 
..  weighted  by  the  flow  fractions.  Thus, 

Fm  «  Fn  «  1.0,  and  deltaP  •  FaPdeltaPm  /v  Fn*daltaPn. 


The  mask  Is  modal lad  as  a  dead  space  and  two  variable  area 
..  orifices  through  which  Inspiratory  and  expiratory  flows  separately 
..  pass.  The  Inspiratory  valve  model  estimates  the  flow  between 
<.  the  mask  supply  hose  and  tha  oronasal  cavity  during  Inspiration. 

Tha  expiratory  valve  modal  relates  the  flow  and  preature  drop  between  the 
..  mask  cavity  and  the  extemel  ambient  atmosphere  during  expiratory  flow. 
...  loth  valve  models  are  based  on  empirical  data  collected  on  the  RAF 
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Prosrwn  IMASICSUBS.FOR 


P/Q  Makf  Mhich  BMts  ^  AtCC  flow  ratittanM  standtrcl.  Other  valve 
■odele  can  be  eubstitutad.  The  general  fora  of  the  aodel  U 

0  -  PfA.deltaP). 


Mhere  A  fa  the  aaak  valve  area  and  Q  ft  the  inetantaneoua 
floM  through  the  valve.  The  valve  area.  A,  Is  In  turn  a  fuwtion 
of  the  preaaure  drop,  deltaA,  aeroes  the  valve.  It  fa  solved  fay 
eatfaating  the  area  of  the  valve  froa  the  pressure  drop  aeroes  the 
valve  and  tiian  conputing  the  flou  through  the  valve  using  idsal 
orifice  equationa.  Naak  leaks  can  be  aodslled  fay  parallel  flow 
paths  to  aabient,  but  rent  are  included  in  this  version.  Expiratory 
valve  coapansation  is  siaulatad  fay  adding  any  poeitive  difference 
betusan  aaak  heae  preaaure  and  aabient  pressure  to  the  expiratory 
valve  deun  atraaa  praasure  uhich  is  noraally  aabient  pressure. 

Nesk  hose  and  connaetor  losses  are  aodslled  as  sluple  tubes  uith 
flou* preaaure  drop  rolationahipo  baaed  on  eapirfcal  data.  The 
regulator  outlet  flou'pressura  relationship  is  based  on  curve  fits 
to  sapirical  data. 


CDC  OOMNQH 

/Y/  tlM  variablaa 

/F/  tfae  dsrivatfves  of  variablaa 

/$/  spatial  dsrivativaa  of  variables 

/k/  A  /!/  real  and  intogar  paraasters  required  to  define  constants 
define  the  spatial  integration  grid. 

FAAANETEk  (IM«3) 

IMPLICIT  IXUU  PRECItlON  <A*H,  0-Z) 

DOMU  PRECItlON  KG.  KP1.  KPIQK,  HOKMI,  HOKPI 

INTEGER  NSTOP,  NORUN,  IP,  NEON 

COMRM/T/  T,  XT,  NSTOP,  NORUN 

1  /Y/  VaiNOE),  FLOUINDE),  PRESS(NOE).  I 

V0l<1}  M  Cuajlativc  voluw  flow  froa  regulator  [irS] 
VOLIZ)  [•]  Cuailative  voluas  flou  into  assk  [m^3J 
VOLIS)  l«l  Cuailative  Respired  voluse  llnsp  -  ExpIDi'Bl 

FL0lf<1)  (■]  Inatantanaoui  flow  froa  regulator  orS/aec] 
FUM<2)  t*l  Inetantaneoua  assk  flou  Da'S/sec] 
FL0U<3)  M  Inatantaneoua  Oro^nasal  flou  bTS/see] 

PRESS(I)  [•]  Regulator  Outlet  Pressure  [Pa] 

PRESSfZ)  [•]  Nssk/Oronesal  Cavity  Press. (Pal 
PRESS(3)  [•]  Intra  Pulaonary  Pressure  [Pa] 

2  /F/  OVDT(NOE),  OFOTCNDE),  OPOT(NOE). 

Oerivetivea  of  Votuasa  and  Prassuras 


/S/  DUMMY 

/R/  PI,  PO,  VO,  TO,  RUNIV, 
PA2MN, 

KG.  KP1,  KOKMI,  KP10K, 
TNOOK,  TNKOK,  TWXKP1, 
TUQ0KN1,  ONEOK, 

CD, 

TROOY,  TAME,  PANE, 

GNU.  GNUS.  GASK,  GASKS, 
GAN,  ONEGA.  TINSP,  FRN, 
TR,  TPAUSE,  RR.  VTIDAL, 


I  Spatial  Darivatives  if  needed 
I  Pi  ■  3. 1412...,  Std  P.V.T*  R 

KOKPi.l  K,  K/(K-1),  (K+1)/K,  1/K,  2/K,  etc 
I  Adiabatic  constant  and 
I  derived  constants 
I  Orifice  Discharge  Coefficient 
I  Taaparatures  •  Body  I  Aabient 
I  Gas  paraasters  NU  A  Specif  Heat  ratios 
I  Breathing  flow  paraaeters 
I  Breathing  flou  paraaeters 
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ProarMn  MASKSUBS.FOR 


•  VWCO,  F*C,  PPWOOT,  I  Initial,  Currant  F»C,  ppH20  Body 

•  MK2).  AUKS).  MiE(3).  I  Airuay  paraMtara 

•  VAO,  VNAO,  CINERT,  OPAU.I  Airuay  paraMtara 

•  AUl,  DVL,  I  Airuay  inartanca 

•  PRE60,  PtEF,  fidotl,  I  Ragulator  Outlat  Praaaura 

•  VPSMSK,  ANIV,  AMEV,  I  Naak  paraMtara 

•  QIV,  flCV,  i  Naak  valva  flou  indicatora 

•  VOLI,  V0I.2,  V0L3,  V0L4.  I  VoluaM 

•  AM,  AUO,  AM,  AUAr,  I  Atoaiic  uta 

•  fiNI2,  GN02,  MOOZ,  I  Nolacular  uta 

•  GNN20,  GNUAIR,  I  n  •• 

•  FINSPIA),  FEXP(4)  IGaa  Fractiona,  02,M2>Ar,C02,H20 

5  /!/  IP  ,  IRELF  I  Print  Couitar 

6  /N/  NEON 

.!  Sat  Conatanta  aaployad  in  aiaulation 
Pi  >  3.U159... 

..  TO  ■  FrMXinp  point  of  uatar  at  1  atMaphara 

..  VO  ■  Voluaa  oeeis>f«d  bV  1  kg*Ml  of  idaal  ga*  at  1  at*  and  Tzaro 

..  PO  •  Standard  atampharic  praaaura  in  Paaeala  {N/ar'2] 

Pi  -  OACOS(-I.DO) 

TO  >  273.100  I  dag  K 

VO  >  22.4Q97M  I  oTS/kg-Ml 

PO  >  1.0132S05  I  Pa 

g^aa  ■  1.400  I  k  ■  Spacific  Haat  Ratio  Cp/Cv 

CO  •  O.tt  I  Orifica  coafficiant 

FM  •  0.7SOO  i  Fraction  anuth  braathing 

VAO  ■  150.0*6  I  Raapiratory  Anatoaiieal  Daad  Spaca  (■^3) 

VDSNSK  ■  150.0*6  I  Oronaaal  Naak  Daad  Spaca  (ar3) 

VFRCO  >  2.50*3  I  Raating  Functional  Raaidual  Capacity 

OVL  •  2.25020*7  I  Rata  of  Lung  Voltaa  Incraaaa  par  Paacal  of  PPB 

«MM  >  1.00000  I  Atoaiic  Ut  Hydrogan 

AM  >  14.0100  I  AU  Nitrogan 

AM  •  16.00  I  AU  Oxygon 

am  -  12.0100  I  Ml  Carbon 

AMr  •  39.9400  I  AU  Argon 

DERIVED  CONSTANTS 

PV  >  RT  Univaraal  Gaa  Lau 

RMIV  «  PO*VO/TO  Univaraal  Gaa  Conatant 

RM1V«P0^/T0 

KP1  >  CASK  *  1.00  I  k  ♦  1 

KOMI  -  6ASK/<6ASK  -  1.00)  I  k/<k  *  1) 

KP10K  •  KP1/GASK  I  (k  ♦  1)/k 

nXPI  -  GASK/KPI  I  k/(k  4^  1) 

TUOOK  -  2.00/6ASK  I  2/k 

TNKOK  >  (2.00  *  6ASK)/GASK  I  (2  *  k)/k 

TWOOKPI  •  2.00/KP1  I  2/(k  *  1) 

TUOOKN1  a  2.D0/(CASK  •  1.00)  I  2/(k  -  1) 

ONEOK  •  1.D0/6ASX  I  1/k 

TANS  a  TO  25.00  I  Aiabiant  Taiaparature 

TBGDY  a  to  37.00  I  Body  TaaaM'*«tura 

PA2HN  a  760.00/1 .0132505  I  Convaraion  Factor  Pa  to  anHg 

PAMS  a  1.0132505 

PREF  a  PANS 

ONHTO  a  AUH*2.00  ♦AUO  I  NU  Uater 

GNCOe  a  am  ♦  2.00*AUO  I  NU  Carbon  Oioxide 

GN02  a  2.D0aAM  I  NU  N2 

ma  a  Z.OOaAM  t  NU  02 

GNUAIR  a  0.209500*GN02 
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Program  MASK8UBS.F0R 


♦  0.780eoO*tMN2 

*  0.00ra00*AIMr  I  NU  Dry  Air  (N«fllcct  O.MX  C02) 

AUR  >  «VAO  ♦  VMNtK)*3.00/4.D0/Pi)**(1. 00/3.00)  I  Afrwy  radiu* 
AUL  >  2.00*AMI  I  Charactarittic  lanoth  of  airway 

AUA  >  Pi*AMl*AW  I  Charactariatic  airway  araa 
AUl  ■  AML/AUA  I  Airway  Inartanca  (ar'l) 


!!  INITIAL  CONDITIONS  (T  ■  0) 

RNSPIRATIOH  RATE  (Iraatha/ain) 

RR  ■  20.00/00.00  I  Sraatha  par  aacond 

TR  ■  1.00/RR  I  Raapiratory  pariod 

TINSP  ■  TR/2.00  I  IfMpiratory  pariod 

TPAU8C  ■  0.100*TR  I  Intartaraath  pauaa  duration 

VDOTE  «  MINUTE  VOLUME  (M^3/SEC] 

VTIOAL  ■  1.S0-3  I  Tidal  VolUM  -  1.5  liter/breath 

VDOTE  >  RR^IDAL  I  VdotE  in  a^3/aac 

QAM  ■  \N>OTE*Pi  I  Paak  Flow  froa  ainuaoidal  flow  profile 

OMEGA  >  2.D0^i*RR  I  RR  in  radiana/aae 

FRN  •  0.7SD0  I  Fraction  Mouth  Braathing 

FIMSP(I)  •  0.500  I  Fr  02  inapirad 

PIN»(2>  -  0.500  I  Fr  N2  (Inart)  inapirad 

FINSP(3>  •  0.000  I  Fr  COE  inapirad 

PINSP(4)  •  0.000  I  Fr  H20  inapirad 

FEXP(I)  >  0.1700  I  Fr  02  axpfrad 

FCXP(3)  >  0.0400  i  Fr  002  axpirad 

FE](P(4)  •  0.062D0  I  Fr  1120  exoirad 

FEXP(2}  •  1.00  -  <FEXP<t)  ♦  fB9<3)  *  FEXP(4))  f  fr  M2  (Inert)  expired 

void)  •  P1*((2.540-2)/2.00}*^.00^.00  I  2  a  of  1  in  ID  hoae 

VQL1  a  VDL(I)  f  Paraaetarixa  initial  voluaea 

VQL(2)  a  VDSMSK  ♦  VAO  I  Includa  aaak  cavity  and  anatoaical  dead  apace 

V0L2  a  vaL(2) 

VOL(3)  a  VFRCO 
VDL3  a  va(3) 

PMOO  a  PANS  I  Initialize  regulator  outlet  preasure 

AMIV  a  0.00 

ANEV  a  0.00 

QIV  a  0.00 

OEV  a  0.00 

PPUOQOY  a  47.00/PA2MM  I  Convert  aaturation  preaaure  to  Paacala 
i  a  1 

DO  WHILE  (i  .LE.  NDE)I  Initialize  flowa,  preaaurea,  and  derivativea 
PRESSd)  a  PANS 
FLOH(i)  a  0.00 
DFDT(i)  a  0.00 
DVOT(i)  a  0.00 
DPOT(i)  a  0.00 
i  a  I  ♦  1 
END  00 

...  Conputa  Starting  valuea  for  derivativea  by  calling  DERV 
CALL  OERV 

IP  a  0  I  Initialize  print  flag 

IRELF  a  0  i  initialize  RO  flag 
RETURN 
END 

SURROUTINE  DERV 

...  DERV  CALCUUTES  THE  TINE  DERIVATIVES  TO  BE  INTEGRATED  BY  RKF45 
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Program  MASKSUBS.FOR 


OK  COMMON 

/Y/  tfM  var<ablM 

/f/  tiM  dvrivativM  of  vsriablM 

/$/  dtrivativM  of  voriabtos 

/R/  ft  /I/  root  and  intagar  paraaMtara  raqufrad  to  define  conatants  and 
dafina  the  apat^*^  intagration  grid. 

IMPLICIT  OOU8LE  PRECISION  (A-H,  0-Z) 

DOUBLE  PRECISION  KG,  KPI,  KPIOK,  KQKNl,  K0KP1 
DOUBLE  PRECISION  DPNIE,  OPNI.  OPNE 
INTEGER  NSTOP,  NORUN,  NDE,  IP,  NEON 
PARAMETER  (N0E>3) 

COMNON/T/  T,  XT,  NSTOP,  NORUN 

1  /Y/  VOL(NDE),  FLOU(NOE),  PRESS(HOE),  I 

V0L(1)  M  Cuulativ*  voltjae  flow  froai  regulator 
yOL(2)  [■]  Cuaulativa  voluaa  flow  into  nask 
V0L(3)  (■]  CuBilative  Reapirad  voluae  (Inap  *  Exp) 

FLOU(I)  t>l  Inatantanaoua  flow  fr««  regulator  [B*3/aec] 
FL0U(2)  C>1  Inatantanaoua  aaak  flow  [a^S/aec] 

FL0U(3)  t*]  Inatantanaoua  Oro*naaal  flow  Da^S/aec] 

PRESS<1)  M  Regulator  Outlet  Preaaure 
PRESS(2)  [a]  Naak  hoae  preaaure 

PRESS(3}  [a]  Maak  cavity  Preaaure  a  intraoral  preaaure 

2  /F/  OVDT(NOE),  OFDT(NDE),  OPOT(NOE), 

Derivativea  of  Voluaaa  and  Preaaurea 


/S/  DUMMY  I  S 

/R/  PI,  PO,  VO,  TO,  RUNIV,  I  Pi 

PA2NN, 

KG.  KPI,  K0KN1,  KPIOK,  K0KP1,I  K,  K/(K*1),  (K4^1>/K,  VK,  2/K.  etc 
TUOOK,  TMKOK,  TWOOKPI,  I  Adiabatic  conatant  and 
TUOOKM1,  ONEOK,  i  derived  conatanta 

CO,  I  Orifice  Diacharge  Coefficient 

TBOOY,  TANg,  PAMg,  I  Toepereturea  -  Body  ft  Aabient 
GNU,  GNUS,  CASK,  GASKS,  I  Gaa  poranetera  MW  ft  Specif  Heat  ratios 
QAM,  ONEGA,  TINSP,  FRN,  I  Breathing  flow  peraawters 
TR,  TPAUSE,  RR,  VTIOAL,  I  Breathing  flow  paraaieters 
VFRCO,  FRC,  PPWgOOY,  I  Initial,  Current  FRC,  ppH20  Body 
AN(2),  ANI<3),  ANE(3>,  I  Airway  paraMters 


I  Spatial  Derivativea  if  needed 
I  Pi  «  3.1412...,  Std  P,V,Tft  R 


VK,  2/K,  etc 


VFRCO,  FRC,  PPWBOOY, 
AN(2),  ANI<3),  ANE(3>, 


VAO,  VMAO,  CINERT,  0PAW,l  Airwey  para 


AUI,  DVL, 

PREGO,  PREF,  Gdotl, 
VDSNSK,  AMIV,  ANEV, 
OIV,  OEV, 


I  Airway  paranetera 
I  Regulator  Outlet  Pressure 
I  Nask  peraneters 
I  Nask  valve  flow  indicators 


VOLI,  V0L2,  VDL3,  VOL4,  I  Voluaes 


AUN,  AWO,  AWH,  AUAr, 
GMN2,  GM02,  GNC02. 
GNH20,  GNUAIR, 
FINSP(4),  FEXP(4) 
/I/  IP  ,  IRELF 
/N/  NEON 


I  Atonic  wts 
I  Molecular  wts 

I  M  « 

IGas  Fractions,  02,N2«Ar,C02,H20 
t  Print  Counter 


...  THE  NUMBER  OF  DIFFERENTIAL  EQUATIONS  IS  IN  COP  X)N/N/  FOR  USE  IN 
...  SUBROUTINE  FCN 

...  COMPUTE  DERIVATIVES 


Define  aona  statenent  FuKtions 
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Program  MASKSUBS.FOR 


irapiratory  and  axpiratory  raaiatanca  of  tha  anuth 

DPMIEfO)  *  2.3505*0  *  2.9407*0*0  I  Mouth  dP  va  0  for  inapiration  and  axpirotion 

(  Voluat  FtoM 

Inapiratory  noaa  raaiatanca 

OPNKO)  ■  2.9405*0  *  2.9408*0*0  I  Hoaa  dP  va  0  for  inspiration 

I  Voluaa  flow 

Expiratory  noaa  raaiatanca 

OPNEIO)  a  2.9405*0  *■  3.9208*0*0  I  Noaa  dP  vs  0  for  expiration 
C...  I  voluae  flow 

VTOT  a  V0L2  *  V0L(3)  I  Ling  Voluaa  and  Daadspaca  Volune 
TED  a  TR  *  TPAUSE  *  TPAUSE/2.00 
TC  a  TR  *  TPAUSE  I  Tia»  par  raapiratory  cycla 
ROF  a  0.00  I  RD  Flag  OFF 

IF(T  .CE.  TRO  .ANO.  PAMB  .GT.  6.6860804)  THEN  IRAPID  DECOMPRESSION 
PAMi  a  DNAXKI. 0132505 

*  -  2.00*3.4464304*(r  •  TR0)/TC,  6.68607D4) 

ROF  a  1.00  I  sat  RO  Flag  ON 

END  IF 
PREF  a  PANS 

IF  (PRESS(I)  -  PREF  .GT.  5.02  .ANO.  FLOU(I)  .EO.  0.00)  THEN 

PRESSd)  a  DNINKPREF  *  5.02,  PRESS(1))I  Sinulate  a  2  imUg  relief  valve 
PREGO  a  PRESSd) 

ELSE 

PREGO  a  DMINKPREGO,  PREF) 

PRESSd)  a  DMINKPREGO, PRESSd)) 

END  IF 

RNQAO  a  PRESS(2)*GNUAO/RUNIV/TBOOY  <  Density  Oronasal  cavity 

IF  fONOoir.rc)  •  tpause  ,ge.  o.oo)  then 

XT  a  dM00(T,TC)  •  TPAUSE  I  Coapute  tiM  froa  onset  of 
ELSE  I  Inapi ration 

XT  a  0.00  I  Pause  tine 

END  IF 

IF(T  .GT.  TRO  .AND.  T  .LT.  2.D0*TC  *  TPAUSE/2.D0)  XT  «  0.00 
GI  a  0.00  i  Inspiratory  Flag 

IF(XT  .GT.  0.00  .ANO.  XT  .LE.  TINSP)  01  >  1.00  I  Inspiratory  Flag 
QE  a  1.00  ■  GI  !  Expiratory  Flag 

i  a  1 

DO  UNILE  (i  .LE.  NOE) 

PRESSd)  a  OMAXKPRESSd),  1.02)1  Absolute  pressure  .GE.  100  Pa 
{  a  f  +  1  I  Don't  allow  negative  absolute  pressure 
END  DO 

IF(PRESS(2)  .GT.  0.00)  FINSP(4)  a  ppUB00r/PRESS(2)  i  Mole  Fraction  H20 

FIMSP(2)  a  1.00  -  (FIHSPd)  ♦  FINSP<3)  *  FINSP(4))  I  Inert  Gas  Fraction 

GMUAO  a  CALMU(FINSP)  i  MU  Oronasal  Cavity  Inspiration 

RNQAO  a  PRESS(3)*GNUA0/RUNIV/TB0DY  I  Density  Oronasal  cavity 

GNUMH  a  FINSPd)*GN02  *  FINSP(2)*GMN2  !  MU  Mask  Hose 

RHONH  a  PRESSd )*GMIMH/RUNIV/TAMB  I  Density  Mask  Hose  Ikg/nTS] 

CMF  a  1.00  -  FRM  I  Fraction  Nose  Breathing  a  i  >  Fraction  Mouth  Breathing 
IF(  XT  .GT.  0.00  )  THEN 

DFOT(3)  a  QANKMEGA*DCOS(CMEGA*XT)  I  Lung  Voluae  Flow  Derivative 
FL0U(3)  a  QAN*OSIN(OMEGA*XT)  I  Lung  Voluae  Flow  [ir3/sec] 

Gdot3  a  FLOU(3)*RHQAO  I  Lung  Mass  Flow  [kg/sec] 

DP  a  DABS(FRM*DPNIE(FL0U(3))  0MF*0PNI(FL0U(3))*QI  I  Pressure 

*  *  OMF*OPNE(FLOU(3))*aE)  I  toss  through  nose  t  anuth 
PRESS(3)  a  presS(2)  •  0P*QI  *  DP*0E  I  lung  pressure 

C3  a  VTOT*GNUAO/RUNIV/TBOOY  I  Lung  Capacitance 
tF(Gclot3  .NE.  0.00)  THEN 

R3  a  DP/Gdot3  I  Airway  Resistance 
ELSE 

R3  a  0.00 
END  IF 
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Program  MASKSUBS.FOR 


OMTCS)  «  -(I.DO/CS^GdotS  *  0F0T(3>*I13)  I  dP/dt  for  Luns 
ELSE 

FLQU(3)  •  0.00 
OdotS  ■  0.00 
0M>T(3)  •  0.00 
0P0T(3)  a  0.00 

IF(FL0U(2)  .EO.  0.00)  PRESS(3)  >  PRESS<2) 

ENOM)  ■  ME$S(2}*Glft»O/M)NIV/TBC0Y  !  Density  Oronasal  cavity 
ENO  IF 

0PLUN6  ■  PtESS(3)  '  PAM  I  Oiffarantial  Lung  Pressure 

Calculate  the  area  of  the  inspiratory  and  expiratory  valves 
froai  curve  fits  to  RAF  P/Q  Mask  valve  data  (ASCC  coopliant) 

I  Exp  valve  has  0.5  IrWg  cracking  Pressure 
IF(PI(ESS(2)  .6T.  (PRESSd)  ♦  50.00)  )  THEN 
OlV  a  0.00 

PRESS(I)  a  OMAXUPREOO,  PRESS(I)) 

RHOMH  a  PRESSd )*6NUMH/RIMIV/TAM  I  Density  Mask  Hose  fkg/ii^3] 

FLOUd)  a  0.00 
edotl  a  0.00 
OPOTd)  a  0.00 

FE)CP<2)  a  1.00  -  (feXPd)  *  FEXP(3}  FEXP(4)>  I  Inert  gas  fraction 
GNUE  a  CALIM(FE)(P)  I  Expired  gas  axtlecular  weight 

PEXPV  a  pamb  *  ONAXKO.OO,  PRESSd)  -  PAMS)  *  50.00  I  0.5  Inch  Ug  Spring  Pressure 
I  Coapansation  pressure 

I  Expiratory  valve  beck  pressure  can  be  tailored  to 
I  coapanaation  characteristics  of  a  particular  valve 
OPX  a  0NAX1(PRESS(2)  •  PEXPV,0.00)  i  Oelta-P  Exp  Valve 
AMEV  a  0NAX1(0.00,  ONIN1(3.8AO<7*OPX  •1.110'5.1.60-4)>IArea  Expiratory  Valve 
PNASK  PMHOSE 

CALL  ORIFLOCCO,  ANEV,  PRESS<2).  PEXPV  .  TBOOY,  GHWE, 

*  FL0M(2),  GdotE,  PCRIT)  i  Expiratory  valve  flow 
FLOU<2)  a  DNIN1<*FLQU(2),  0.00)  I  Flow  is  reve'raed  for  expiration 
IF(FL0U(2)  .LT.  0.00)  THEN 

QEV  a  1.0 
ELSE 

QEV  a  0.00 
ENO  IF 

0P0T(2)  a  PRESS(2)/VTOT*(FLOU(2)  •  FL0W(3))  !  Nask  dP/dt. 

ELSEIF(PRESSd)  .GT.  (PRESS(2)  ♦  10.00))  THEN 
IF  (FLOWd)  .HE.  0.00)  THEN 

PRESSd)  a  0MIH1(PRESSd),PREF) 

ELSE 

PRESStI)  a  OMINKPRESSd),  PREGO) 

ENO  IF 

DPI  a  PRESSd)  -  PRESS(2)  lOelta-P  Inspiratory  Valve 
ANIV  a  OMAXKO.OO,  ONIN1<1.0090-6*OPI, 1.50*4))  lArea  Insp  Valve 
GWI  a  CALNWIFINSP)  I  Inspiratory  gas  laolecular  weight 
C  PMHOSE  PMASK 

CALL  ORIFLOICO,  AMIV,  PRESSd),  PRESS<2),  TANS,  GNWI, 

*  FLOU(2),  Gdot2,  PCRIT)  I  Inspiratory  valve  flow 
FL01K2)  a  0HAX1(FLQU(2),  0.00) 

IF(FL0U(2)  .GT.  0.00)  THEN 
OIV  a  1.0 
ELSE 

OIV  a  0.00 
ENO  IF 

RHCAO  a  PRESS(2)*GMUA0/RUNIV/TBQ0Y  I  Density  Oronasal  cavity 

RHOMH  a  PRESSd )aGMUHN/RUN I V/TAM  I  Density  Nask  Hose  [kg/nrS] 

Gdotl  a  FLaU(2)aRNOAO  I  Ness  flow  into  mask 

FLOUd)  a  Gdotl/RHQMH  I  Volume  flow  from  nask  tube 

OPH  a  0PH0SE(Gdot1 )  I  Pressure  loss  in  hose 

PREGO  a  OMINKPRESSd )  ♦  OPH,  PREF)  I  Regulator  outlet  pressure 

OELTAP  a  PREGO  •  PREF  I  Oifferential  pressure  relative  to  reference 
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OnT(l)  -  1.00/V«.1*(PW(»^TREa<0ELTAP)/RH(MH  I  GTREfi  <■  MSS  flow  v  OP 
*  *  PRESS(1)*FL(M<1))  I  dP/dt  for  «Mk  hot*  outlot  proosuro 

0n>T(2}  ■  P«ESS<2)/VTOT*(FLO«<2)  -  FL0U(3)}  »  dP/dt  for  Muk 
ELSE 

tF(  OIV  .EQ.  0.00  )  THEN 
FLOU(I)  •  0.00 
Gdotl  •  0.00 
OPOT(I)  »  0.00 
OFDTfl)  •  0.00 
PREGO  >  PREF 

PRESSd)  -  ONINKPREGO,  PRESSd)) 

RHOMH  >  PRESSd )*GMUMH/RUN I V/TAM8  I  Dontity  Mask  Hom  Cko/aTSl 

EHO  IF 

IFfOIV  ♦  QEV  .EQ.  0.00)  THEN 
FL0U(2>  -  0.00 
DFDT(2}  >  0.00 

IF(FL0U(3>  .EQ.  0.00)  PRESS(3)  -  PRESS<2) 

OPOT(2)  >  -PRESS(2)/VTOT*FLaU(3)  I  dP/dt  for  Mask 
END  IF 
BE)  IF 

DVDTd)  ■  FLOUd)  I  Cwulatlva  volUM  flow  froa  regulator 
0VDT(2)  -  FLaU(2)  I  Flow  la  darivatfva  of  votuae 
DVDT(S)  ■  FL0U<S)  I  Flow  la  derivative  of  voltaw 
1000  RETURN 
END 

SURRQUTINE  PRINT(HI,NO) 

Print!  aalaetad  output  varlablea  at  the  specified  tine  interval. 


COE  OCNNON 

/Y/  tint  variables 

/F/  tine  derivatives  of  variables 

m  spatiQl  derivatives  of  varisbles 

/R/  a  /I/  real  and  integer  paransters  required  to  define  constants  and 
define  the  spatial  Integration  grid. 

IMPLICIT  OQURLE  PRECISION  (A-H,  0-Z) 

PARAMETER  (NDE*3} 

OQURLE  PRECISION  KG.  KP1,  KPIOK,  KOKMI,  K0KP1 

INTEGER  NSTOP,  NORUN.  IP.  NEON 

COMMON/T/  T.  XT.  NSTOP.  NORIM 

1  m  y%(NDE).  FLOU(NOE).  PRESS(HOE),  I 

VOLd)  M  CuKJlatlve  voluw  flow  fron  regulator 

V0L(2)  (•]  Cuwlative  volune  flow  Into  assk 

VOL(3)  t«l  emulative  Respired  volmie  (Insp  -  Exp) 

FLOUd)  [■]  Instantaneous  flow  froai  regulator  In^3/secl 
FL0U(2)  1>1  Instantaneous  assk  flow  [B"3/sec] 

FL0U(3)  M  Instantaneous  Oro-nasal  flow  OirS/sec] 

PRESSd)  Regulator  Outlet  Pressure 

PRESS(2)  [a]  Mask  hose  pressure 

PRESSO)  (a)  Mask  cavity  Pressure  a  intraorsl  pressure 

2  /F/  DVDT(HOE).  OFOT(NDE).  DPOT(NDE), 

Oerivstivas  of  Voluess  and  Pressures 

3  /S/  DUMMY  I  Spatial  Derivatives  if  needed 

4  /R/  PI.  PO,  VO,  TO,  RUNIV,  I  Pi  a  3.1412...,  Std  P.V.TA  R 

•  PA2MM, 

•  KG.  KP1,  KOKMI,  KPIOK,  KOKPI.I  K,  K/<K-1),  (K*1>/K,  l/K,  2/K,  etc 
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5 

6 


TVOOK,  TNCQK,  TUOOKPI. 
TUOOKNI,  ONEOK, 

», 

TIOOY,  TANK,  PANE. 

ONU,  ONUS,  CASK,  CASKS, 
CMN,  OMEGA.  TINSP,  FRN, 
TK.  TPAUSE.  m,  VTIOAL, 
VFRCO,  FRO.  PPWBOOY,  I 
AN(2),  ANI(3).  ANE(3), 
VAO,  VNAO,  CINERY,  OPAU, 
AUI,  DVL, 

PREGO,  PREF,  Gdotl, 
VDSNSK.  ANIV,  AMEV, 

QIV,  QEV, 

VOL1,  VOL2,  VQU,  VQL4, 
AIM,  AUO,  AUH,  AUAr, 
GIW2,  GN02,  GNC02, 

GMH20,  GMUAtR, 

FIilSP(4),  FEXP(4) 

/!/  IP  .  IRELF  I 

/N/  NEON 


I  Adiabatic  conatant  and 
I  darived  conatanta 
I  Orifica  Diacharga  Coefficient 
I  Yaaperaturea  -  Body  A  Aabiant 
I  Gaa  paraaatara  MU  A  Specif  Heat  ratioa 
I  Sraathing  flou  paraaatcra 
I  Braathino  flow  paraaatara 
Initial,  Currant  FRC,  ppH20  Body 
I  Airway  paraaetara 
I  Airway  paraawtara 
I  Airway  paraaMtara 
I  Regulator  Outlet  Praaaura 
I  Naak  paraaiatara 
I  Naak  valve  flow  indicatora 
I  Voltaaaa 
I  Atoaic  wta 
I  Molecular  wta 
i  “  " 

IGaa  Fractiona,  02,N2'«'Ar.C02.H20 
Print  Counter 


!!!  PRIHY  A  HEADING  FOR  YNE  NUMERICAL  SOLUYION 

IP  ■  IP  ♦  1 
MIYE(NO,2) 

URIYE(NO,2)  Y 

!!!  PRINY  YNE  SOLUYION 

WRIYEf  *,'<tK,2FI0.3)O  T,  XT 

URIYE(  *,3)  Y,  PREGO,  (PRESS(k),  k>1,NDE),  <DPDY(k>,  k>1,HDE> 
URIYEf  *.3)  Y.  (VQL<k),  k«1,N0E).  (FLOU(k),  k«1,N0E) 
MIIYE(NO,2)  Y,  PANS,  PREGO,  (PRESS(k),  k«1,NDE), 

•  (OPOY(k),  kel.NDE),  (VOL<k),  k-1,HOE},  (FLOU<k),  k-1,NDE) 

Z  F0RNAY(F8.4,  1AE17.8) 

I  F0RNAY(1X,F8.4,  30E13.5) 

REYURN 

END 

DOUBLE  PRECISION  FUNCYION  GYREG(DP) 

DOUBLE  PRECISION  OP 

...  REGUUYOR  MASS  FLOU  VS  OUYLEY  PRESSURE 
...  BASED  ON  CURVE  FIY 

1F(DP  .GE.  0.00)  YHEN 
6YKG  >  O.DO 
REYURN 
END  IF 

6YREG  «  DMAX1(1.D-10,-1.780-3  -  4.985D-5*OP  -  1.5850-T*0P**2 

*  ■  2.1360-10^P**3) 

IF(DP  .LY.  *3.502)  GYREG  *  S.D-3 
REYURN 

END 

DOUBLE  PRECISION  FUNCYION  POREG(Gt) 

DOUBLE  PRECISION  Gt 

...  Regulator  differential  outlet  presaure  *  fdnass  flow  at  outlet) 
...  unite:  Pa  va  kg/aec 

POREG  "«  *46.7200  *  1.219D4*Gt  *  1.00907*Gt*Gt  I  Pascals 

IF(6t  .LY.  0.00)  POREG  «  0.00 

REYURN 

ENO 
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OOUILE  PtEClSION  nMCTlON  l>PHOSE(Gt} 

...  NMk  hoM  RMlstanc* 

DOUlU  PRECISION  6t 

DPHOSE  ■  1.1<62M*6t  *  5.2S06*6t*Gt  I  dt(ta*P  hoaa  vt  volUM  flow 

RETURN 

END 

SURROUTINE  ORIFLOCCOORIF.  MEA,  PUP.  POW.  TASS,  GMWT. 

•  FLOHVOL,  FLOUNASS,  PCRIT) 

**  Subroutlrw  ORIFLO  umc  th«  coapr— «<bl«  flow  equations  for  an  idaal 
gat  to  coaputa  tha  flou  through  an  orifica  given  the  upatraaa  and 
dounatraaa  conditiona,  tha  orifice  area,  and  tha  gas  parsaaters. 


PARAMETERS  DESCRIPTION  UNITS 


CO 

[•1 

The  orifice  discharge  coefficient 

OMITLESS] 

AREA 

W 

The  aree  of  the  orifice 

(SQ  METERS! 

TABS 

W 

The  absolute  taaperature 

[DEG  KELVIN] 

GMU 

t«l 

The  aoleculer  ueight  of  the  gas 

[KG/KG-MOLl 

GASK 

M 

The  adiabatic  exponant  ratio  of  specific 
heats  of  the  gas  (Cp/Cv) 

tUNITLESS] 

RUNIV 

M 

Universal  Gas  Constant 

tNEUTONraETERS/KGMOL/OEG  K] 

VARIABLES 

PUP 

W 

Upetreaa  absolute  pressure 

[PASCALS] 

POun 

(>] 

Dounstreaa  absolute  pressure 

[PASCALS] 

•••••WrPUT  PARAMETERS 

FLOUVQL 

{■1 

Veluaetric  flou 

[CU  METERS/SEC] 

FLOUMASS 

W 

Mass  flou 

[KG/SEC] 

PCRIT 

W 

Critical  dounstreaa  pressure  for  sonic  flou. 

[PASCALS] 

•••••••••NOTE:  If  other  units  are  desired,  tha  universal  gas  constant 


RUNIV  aust  be  changed  to  the  correct  value  for  the  chosen  units. 


IMPLICIT  DOUBLE  PRECISION  IA-H,0-Z} 

DOUBLE  PRECISION  KG.  KP1,  KPTOK,  KQKM1.  KOKPI 
COMMON  /R/  PI,  PO,  VO,  TO.  RUNIV,  I  Pi  >  3.1412...,  Std  P,V,Tk  R 
PA2MN, 

KG,  KP1,  KOKMI,  KP1QK,  KOKPI, I  K.  K/(K-1),  (K+1)/K,  1/K,  2/K,  etc 

TUOOK,  TMKOK,  TU00KP1,  I  Adiabetic  constant  and 

TUOQKMI,  ONEOK,  I  derived  constants 

CO,  I  Orifice  Discharge  Coefficient 

TBOOr,  TAMB,  PAMS,  I  Tea|peratures  •  Bod/  S  Aabient 

GMU,  GMUS,  GA8K,  GASKS,  I  Gas  psrsastare  MU  i  Spacif  Haat  ratios 

QAM.  OMEGA,  TIHSP,  FRM,  I  Breathing  flou  paraaeters 

TR,  TPAUSE,  RR,  VTIDAL,  I  Breathing  flou  parsaaters 

VFRCO,  FRC,  PPUBOOY,  I  Initial,  Current  FRC,  ppHZO  Bod/ 

AM(2).  ANI(3).  ANE(3),  I  Airuay  paraaeters 
VAO,  VMAO,  CINERT,  DPAU.I  Airuay  paraaeters 
AUI.  DVL, 

PRE60,  PKF,  Gdotl,  I  Regulator  Outlet  Pressure 

WSMSK,  AMIV,  AMEV,  I  Meek  peraaaters 

QIV,  QEV,  I  Mask  valve  flou  indicators 

VOL1,  VOL2,  V0L3,  VDL4,  I  Volinas 

AUN,  AUO,  AUH,  AUAr,  I  Atoaic  uts 

GMN2,  GM02,  GMCQ2,  I  Molecular  uts 


GMN20  GMUAIR  I  *  • 

FIN8P(4),  FEXP(4)  IGas  Fractions,  02,N2fAr,C02,H20 
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COMMON  /I/  IN  .  IRELF 

MESHIVE  THE  CALLING  CONSTANTS  AND  VARIABLES. 


THESE  CONSTANTS  00  NOT  CHANGE  DURING  A  SINGLE  CALL, 

BUT  NAY  CHANGE  BETUEEH  CALLS. 

IF(PUP  .EG.  POUN  .OR.  PUP  .LE.  0.00  .OR.  TABS  .LE.  0.00  .OR. 

•  POUN  .LE.  0.00  .OR.  AREA  .LE.  0.00  .OR.  GNWT  .LE.  O.DO)  THEN 
FLOUMASS  >  0.000 
FLOUVOL  ■  0.000 
RETURN 
END  IF 
UT  >  GNUT 
PU  «  PUP 
PD  -  POUN 
PR  -  PD/PU 
C  •  CDORIF 
A  >  AREA 
T  •  TABS 

R6AS  >  RUNIV/WT  I  SPECIFIC  GAS  CONSTANT 

FUD  -  1.00  I  FORUARO  FLOW  FLAG 

IF  <PR  .GT.  1.000)  THEN 

FUD  ■  -FUD  I  REVERSE  FLOW 

PR  ■  1.Q00/PR  I  EXCHANGE  PU  A  PD 

PTENP  «  PU 
PU  •  PO 
PO  >  PTEMP 
END  IF 

RHOU  •  PU/(RGAS*T)  I  UPSTREAM  GAS  DENSITY 

PCRIT  >  TUaaKP1*nQKM1*PU  (  CRITICAL  PRESSURE  FOR  SONIC  FLOU 

*  IF  DOUNSTREAN  CONDITIONS  <  PCRIT  USE  SONIC  EGUATIONS 

99  FORNATISX.SEZO.B) 

IF<PO  .LT.  PCRIT)  THEN 

•*  SONIC  CONDITIONS  APPLY  IF  PO  <  .OR.  >  PCRIT 

FACT  •  2.0D0*nXP1 

ARG  ■  PU*RH0U*FACmU00KP1**TW0QICM1 

IF(ARG  .LT.  0.00)  PAUSE  'INVALID  ARGUMENT  IN  ORIFLOW' 

FLOUMASS  a  FUD*C*A*OSaRT(ARG) 

FLOUVOL  a  FLOUMASS/RHOU 
ELSE 

ELSE  USE  THE  SUBSONIC  EGUATIONS 

FACT  a  2.000n0»1 
ST  a  OSQRTIT) 

ARG  a  FACT/RGAS*(PR**TUOOK  -  PR**ICP1QK) 

IF(ARG  .LT.  0.00)  PAUSE  'INVALID  ARGUICNT  IN  ORIFLOU' 

FLOUMASS  a  FUD*C*A/ST*PU*OSaRT<ARC) 

FLOUVOL  a  FLOUMASS/RHOU 
END  IF 
RETURN 
END 

SUBROUTINE  DICAN(IATOP,ALT,PABS,TEMPK) 

MOOIFIEO  7/12/87  TO  INCLUDE  IMPROVEMENTS  PROGRAMMED  BY  MR  L.  GILL  OF 
NOOG  CARLETQN  GROUP. 

DOUBLE  PRECISION  VERSION  CREATED  12/1/93  FOR  MA5KMC0EL 


433 


u u u u u u u u u u u u u  uuu  uuu  uuu  uuuu  uuu  uuuuu 
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ICM  COMPUTES  THE  AISOLUTE  PtESSUK  POI  A  CIVEH  ALTITUDE 
TOR  VICE  VERM)  RT  ICAN  STANMRO  ATMOSPHERE  MOOEL(1953). 

TO  COMPUTE  PRESSURE  FROM  ALTITUDE  SET  lATQP  .GE.  0 
TO  COMPUTE  ALTITUDE  FROM  PRESSURE  SET  lATOP  .LT.  0 

UNITS  ON  ALTITUDE  RETURNED  IN  FEET. 

TNE  AMOIUTE  TEMPERATURE  ESTIMATE  FOR  THE  ALTITUDE  IS 
RETURNS  IN  0E6  KELVINCTEMPK). 

TNE  MODEL  IS  MOST  ACCURATE  SETUEEN  -1,000  AND  100,000  FEET. 

IMPLICIT  OOURLE  PRECISION  <A-H,  O-Z) 

INTEGER  lATOP 

X  >  S.ZSEDO 

TC  >  O.SO-3 

TO  >  ZM.IttO 

SCALE  >  1.0D-5 

IFdATOP  .LT.  0)  GO  TO  20G 

ALT  >  ALT/1000.00 

CNECK  FOR  TNOPOPAUSE 

IFCALT  .GT.  36.00)  GO  TO  150 

MODEL  FOR  NELOW  TROPOPAUSE 

TEMPK  ■  TO  -  TC*ALT 

PASS  «  «rO-1.W120O*ALT)/T0)*n«(Z.15287D0*ALT-8.16554O0)*SCALE 
GO  TO  999 

MODEL  FOR  AMVE  TROPOPAUSE 

ISO  C  •  0.2Z«00*10.00~((36.0889DO  -  AlT)/47.a996800) 

1P(ALT  .LT.  50.D0)  S  >  (2.5200*ALT  •  90.500)*SCALE 

IF(ALT  .GE.  50.00)  S  «  (0.228A00*ALT  >  21.77S00)*SCALE 

PAM  ■  C  ♦  B 

TENPK  >  273.2D0  •  56.500 

GO  TO  999 

COMPUTE  ALTITUDE  FROM  PRESSURE 
CNECK  FOR  TROPOPAUSE 

200  IFIPAM  .GE.  .OOIDO)  GOTO  205 
ALT  •  170.00 
GOTO  999 

205  1F(PAM  .LT.  0.223600)  GO  TO  250 

MODEL  FOR  GELOW  TROPOPAUSE 

AITOLO  ■  T0/TC*<1.00  -  PASS^(1/X))/1000.00*3.28100 
210  ARC  •  (2.15287DO*ALTOLO  •  8.1655«00)«SCALE 

ALT  a  T0/1.9812D0*(1.O0  •  (PASS  -  ARC}*«(1.D0/X» 

TB1PK  a  TO  •  TC*ALT 

IF(AM(ALT  -  ALTOLO)  .LT.  1.D-4)  GO  TO  999 
ALTOLD  a  (ALT  *  ALT0U»/2.D0 
GO  TO  210 

MML  FOR  ASOVE  TROPOPAUSE 

CHECK  FOR  50000  FEET  OR  ASOVE. 

250  ALTOLO  a  (DL0G10(0.223600/PABS)*14.600  ♦  11.00)*3.281D0 
260  •  a  (2.52DO*ALTOLO  *  90.500)*SCALE 


434 


uuuuuuuuuuuuuuuuuuu 
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IPCMM  .IT.  O.IISlIttM)  •  •  C0.22a«>0*W.T0t0*21.775O0)*SCALE 
ALT  >  SA.OaanO  •  47.a996aD(mL0610((PAM  •  l)/0.22400) 


273.2D0  •  56.500 

IF(AM(ALT  -  ALTOLO)  .LT.  1.0-4)  GO  TO  999 
ALTOLO  >  (ALT  *  ALT0L0)/2.00 
GO  TO  260 

999  ALT  >  ALT*1000.00 


RETtAW 

EM) 

EUEEOUTIME  NILCAS(9ABACF,PAICAB,PNAX,lUNiTS) 


OOUMJ  MECltlQN  VERSION 


U.S  NtLSKC  CAIIN  PRESSURIZATION  SCHOULE  AS  DETAILED 
IN  NIL-E-3a4S3A  (USAF)  2  DEC  1971. 

GIVEN  AGSOLUTE  PRESSURE  OP  AIRCRAFT  NILCAB  RETURNS 
TNE  CANIN  ASSOLUTE  PRESSURE  OR  VICE  VERSA. 

TO  CONPUTE  CMIN  FRON  ACFT  SET  INVERT  .GE.  0. 

PRESSURE  UNITS  SET  BY  lUNITS 
SET  lUNITS  -  0  FOR  PSIA 
SET  lUNITS  >  1  FOR  NN  HG 

PNAX  •  TNE  NAXINUN  DIFFERENTIAL  PRESSURE  PRODUCED  BY  THE  ECS 


INPLICIT  OOUKE  PRECISION  (A-H,  0-Z) 

INTEBER  lUNITS 

am  •  51.7200 

IFdUNlTS  .BO.  1>  PABACF  -  PABACF/CPHN 
IF(PABACF  .BT.  10.9200)  GO  TO  110 
BO  TO  120 

110  PABCAO  •  PABACF 
BO  TO  999 

120  IF(PABACF  .LE.  10.91700  -  PNAX)  GO  TO  130 
PABCAB  -  10.91700 
BO  TO  999 

130  PABCAB  •  PABACF  ♦  PNAX 
999  IFdUNirS  .BE.  1)  IMTURN 
PABCAB  •  PABCAB*CPNN 
PABACF  •  PABACF*CPNN 
RETURN 
END 

OOUBU  PRECISION  FUNCTION  PBFORA(PCH) 

C 

C  CONFUTES  PRESSURE  BREATHING  FOR  ALTITUDE  AS  A  FtMCTION  OF  AMBIENT  PRESS 
C 

IMPLICIT  DOUBLE  PRECISION  (A-H,  0-Z) 

IF(PCN  .BT.  0.200}  THEN 

PBFORA  >  0.000 

ELSE 

PBFORA  ■  ONAX1(0.0400,0.09400-0.4WO*PCH) 

END  IF 
MTURN 
END 

DOUBLE  PRECISION  FUNCTION  0VL(0PLUNG} 

C 

C  COMPUTES  FUNCTIONAL  RESIDUAL  VOLUME  AS  FUNCTION 
C  OF  DIFFERENTIAL  BREATHING  PRESSURE 
C 

DOUBLE  PRECISION  0PLUN6 
OVL  «  2.2502D-7*DPLUNG 
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Proonm  MASKSUBS.FOR 


Mmim 

IMQ 

WMOUTINf  PULFCN(TINe,PPIM.T,VDOTE.QPEAK.QItESI>,VLUNG) 

INHICIT  DOWLE  PtECISION  (A-H,  0-Z) 

OOMIE  MKCISION  KG,  KP1,  KP10K.  K0HN1,  KOCPI 

OOMKM/T/  T.  XT,  MTOP,  HOMM 

OOMMM  /!/  M,  ra,  VO,  TO,  KUNIV,  I  Pi  >  3.1412...,  Std  P,V,Tt  R 

•  PA2NN, 

•  KG,  KP1,  Kami,  KP1QK,  KDKP1,I  K,  K/(K>1),  (K^1)/K,  1/K,  2/K,  Me 

•  Timx,  TtOCDK,  TUOOKPI,  I  Adiabatic  eonatant  and 

•  TUDOnn,  ONEOK,  I  darivad  eonatanta 

•  GO,  I  Orifiea  Diacharga  Coafficiant 

•  TOOOr,  TAMB,  PANG,  f  Taaparaturaa  -  Bed/  A  Aabiant 

•  GMU,  ONWS,  GASK,  GASKS,  I  Gaa  paraaatara  MU  A  Spacif  Haat  ratioa 

•  QAN,  ONEGA,  TINGP,  FUN,  I  Rraatbing  flow  paraa»tara 

•  TR,  TPAUSE,  RR,  VTIOAL,  I  Braathina  flow  paraaatara 

•  VFRCO,  rac,  PPUBOOT,  I  Initial,  Currant  FRC,  ppM20  Body 

•  AN<2),  ANt(3),  ANE(3),  I  Airway  paraaatara 

•  VAO,  VMAO,  CINERT,  OPAU,!  Airway  paraaatara 

•  AUl,  DVL, 

•  PREGO,  PREF,  Gdotl,  I  Roflulator  Outlat  Praaaura 

•  VDWSK,  ANIV,  AMEV,  I  Naak  paraaatara 

•  QIV,  OEV,  I  Naak  valva  flow  indicatora 

•  V0L1,  ¥012,  V0L3,  Va4,  I  Voluaaa 

•  AUN,  AUO,  AUH,  AUAr,  I  Atoaic  wta 

•  GNN2,  GNQ2,  GN002,  I  Nolaeular  wta 

•  GNN20  GFAMIR  I  *  ** 

•  FINSPIA),  FEXP(4)  IGaa  Fractiona,  02,N2-i-Ar,C02,H20 

OOFT(T,aN.W)  •  GN^SlNlun) 

VU)FT(T,aN,U)  >  QN/U*(1.0DO-DOOB(U*T)) 

VFRCfPB)  >  2.SD0  ♦  0.100^760.00 
TUQPI  a  2.00^1 

PEAK  FUU  a  VOQTE^l  FOR  A  HALF  UAVE  RECTIFIEO  SINUSOIDAL 
OENANO  FLOU  PATTERN. 

OPEAK  a  VOOTE^I 

UK  TK  CURVE  FIT  VTIO  TO  ESTIMATE  TIDAL  VOLUME  FROM  AVERAGE  FLOU. 

THEN  DIVIDE  BY  VE  TO  GET  TAV,  TK  AVEUGE  TIK  PER  BREATHING  CYCLE. 

CALL  VTIOL(VDOTE,VTIDAL} 

TAV  a  VTIOAL/VDQTE 

COMPUTE  KSPIRATION  RATE  FROM  KSP  RATE  (BREATHS/TIK)  ■  1/TAV 
RR  a  1.00/TAy 

SCALE  TIK  FROM  MINUTES  TO  KCONDS/CTCLE 
TAV  a  TAV*60.00 

COMPUTE  TK  AVERAK  RADIAN  BREATHING  FREQUENCY 

OKGA  a  TUOPI/TAV 

GKSP  a  Q0FT(TIK,QPEAK,0KGA) 

VLUNG  a  VFRC(PPBALT)  *  VLOFT(TIK,aPEAK,OKGA)/60.00 

KTURN 

END 


lUBROUTIK  VTIDL(VE,yT> 
C  DOUBLE  PWCISION  VERSION 
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Proaram  MA8KSUBS.F0R 


ISTIMTC  TIDAL  VOLUME  FKM  PULMONARY  VENTIUTIQN  (V  DOT  E)  ACCORDING  TO 
A  TNE  MDOIL  OP  NET  ET  AL.  RESPIRATION  PHTSIOLOGT  (1966)  VI, 191-205. 


USE  NET'S  MEAN  MODEL  PARAMETERS  FOR  *M*  AND  •‘K* 

(MMR  •  2S  ♦/-  2  (l/MINl  AND  KIAR  -  0.31  */•  0.08  (LITERS] ) 

IMPLICIT  DOODLE  PRECISION  (A-H,  0-Z) 

DQURLE  PRECISION  MDAR.KRAR 

MMR  >  28.00 

OAR  ■  0.31D0 

VT  «  VE/MRAR  ♦  OAR 

RETURN 

END 


SUHHMTINE  FI0R(PA02,PACO2,R,PA8,FIO2,FIO2MX,PINSP,PAOXY) 

DOURU  PRECISION  VERSION 

FIOM  EMPLOTS  TNE  ALVEOLAR  AIR  ECUATIQN  FOR  STEADY  STATE  EXCHANGE 
TO  CALCUUTE  TNE  MINIMUM  FRACTION  INSPIRED  02  (FI02)  REQUIRED 
TO  MAINTAIN  PA02  GIVEN  PA002.  R.  AND  ARSOLUTE  PRESSURE(PAR>. 

PRERRURES  MUST  RE  IN  MM  HO.  IF  PRESSURE  RREATHING  IS  REQUIRED 
FI02  IS  SET  TO  1.0  AND  THE  MQUIREO  SAFETY  PMSSURE  IS  RETURNED  IN  PINSP 
IN  MM  NGCGAURE).  TNE  ESTIMATED  ALVEOLAR  OXYGEN  PARTIAL  PRESSURE  WITHOUT 
SAFETY  PRESSURE  IS  RETURNED  IN  PAOKY. 

IMPLICIT  DQURLE  PRECISION  (A*H.  O-Z) 

OMROR  •  (1.00  •  R)/R 

A  •  PADS  ♦  PAOQZ/R 

R  •  PACOZ^MROR  *  PAR  •  67.00 

FIQ2  >  A/R 

PAOKY  «  PA02 

PINSP  •  O.ODO 

IFCFlOe  .GE.  0.00  .AND.  FI02  .LE.  FI02MX)  RETURN 

IFtFIOe  .LT.  0.D0)  GO  TO  999 

PC  «  67.00  -  PACO2*0MRaR  ♦  A/FI02MX 

PINSP  •  PC  •  PAR 

FfOZ  «  FI02MX 

RNEW  >  PAe02«0NR0R  *  PC  -  67.00 
PROXY  >  FI02NX*RNEW  -  PAC02/R 
KTURN 

999  HRITE(*,2}  FI02 

FlOe  •  0. 

2  faRMAT(5X,'**nRR0R  IN  FIOX,  FI02  *  '.1PE12.3) 

RETURN 

END 


SURROUTINE  R0O2(PAO2MN,FRIOZ,FIO2NX,PA8ACF.PASCAB,PSAFTI, 
•PSAFTF,PAC02,R) 

C 

C  DOURU  PRECISION  VERSION 
C 

C  R0Q2  COMPUTES  MINIMUM  FRACTION  INSP  02  REQUIRED  TO  MAINTAIN 
C  3GMM  NR  PROS  FOLLOWING  DECOMPRESSION  FROM  PARCA8  TO  PA8ACF. 

C  CORRECTION  FOR  SAFETY  PRESSURE  IS  MADE.  REQUIRES 
C  SURROUTINE  FI02(PA02.PAC02,R,PA8CAS,F102,FI02MX.PINSP.PA0XY} 

C  PRESSURES  MUST  RE  SUPPLIED  IN  MM  H6.  PA8ACF,  PABCAB  S  PAC02 
C  ARE  ABSOLUTE  PRESSURES,  PSAFTI  IS  GAUGE  PRESSURECMASK  LESS  CABIN). 
C  BEFORE  DECOMPRESSION  PSAFTF  IS  SAFETY  PRESSURE  AFTER  DECOMPRESSION. 


U  U  <J  u  u  u  u  u  u  u  u  u  u  u  u  u  u 


Progrwi  MASKSUBS.FOR 


INKICIT  OOUW.E  PRECISION  (A-H.  0*Z) 

PLI  •  PAKAI  *  PSAPTI  •  47.D0  I  mMR 
PLF  ■  PAIACF  ♦  PUFTF  -  47.00  I  aiNtfl 
PAOZ  «  PAOaNI*PLI/PLF 

CALL  FI0K(PA02.PACO2,R,PAICA»»PSAFTI,FRI02.FI02NX,PIHSP,PA0XY) 

RETURN 

END 


SUBROUTINE  ALVPO2(FIO2.PAO02,R,PAB.PINSP.PAOXY,EQVALT) 

DOUBLE  PRECISION  VERSION 

SUBROUTINE  ALVP02  EMPLOYS  THE  ALVEOLAR  AIR  EQUATION  TO  ESTIMATE 
THE  STEADY  STATE  ALVEOLAR  OKYGEN  PARTIAL  PRESSURE  CPAOKY).  THE 
0QRRESP0NDIN6  ALVEOLAR  CARBON  DIOXIDE  PARTIAL  PRESSURE  (PAC02) 

AND  RESPIRATORT  EXCHANCE  RATIO,  (R)  QIVEN  THE  FRACTION  INSPIRED 
QKTCEN  (FIOZ),  THE  ABSOLUTE  AMBIENT  PRESSURE  (PAR)  AND  THE  LEVEL  OF 
DIFFERENTIAL  PRESSURE  BREATNINC  (PIHSP).  THE  SUBROUTINE  ALSO 
CALCUUTES  THE  ALTITUDE  (EQVALT)  AT  UHICH  THE  EQUIVALENT  PAOXY  IS 
PRODUCED  IF  AIR  IS  BREATHGD. 


IMPLICIT  DOUBLE  PRECISION  (A*H,  0*Z) 

100  SAVP02  >  PAOKY 
MVC02  •  PA002 
ONROR  >  (1.000  •  R)/R 
PARRSP  a  PAR  ♦  PINSP 

PMXr  a  F(0e*(PA0a2nMR0R  *  PABRSP  •  47.00}  •  P/«ta/K 

IFCPAOKT  .LE.  0.000)  THEN 

PROMT  a  FIQ2*(PABRSP  •  47)  •  PAC02 

ELSE 

PAC02  a  1.00/(0.020700  ♦  0.47400/PAaXY) 

END  IF 

1F(PA0MY  .LE.  25.00)  THEN 
R  a  1.0500 
ELSE 

R  a  5.00n)L06(PAC02)-0.784300*ALOG(PAC02)**2.00-6.926600 
END  IF 

500  IF(ABS(SAVP02  •  PROMT)  .LE.  0.0100)  THEN 
00  TO  1000 
ELSE 

PROMT  a  (SAVPO2^A0MT}/2.00 
PAC02  a  (SAVC02^AC02)/2.00 
00  TO  100 
END  IF 

1000  PABRSP  a  (PAOXT  *  PAC02/R)/0.209500  -  PAC02*QMR0R  47.00 
PABRSP  a  PABRSP/759.900 
CALL  DICAN(-1,EQVALT,PABRSP,TEMPK) 

RETURN 

END 


438 


uuuuuuuouuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuououuuuuuuuuuuuuouuu 


Program  RKF46.F0R 


•OfOC  INCF4S 

SUMQUTINE  IKF4S(F.NEQN.r.T.TaUT,KELEM,AIS6S>.IFLAC,U0ftK,IUmK) 

FEHLKRG  FOUBTN-FIFTH  OEOEE  MMGE-KUTTA  METHOD 

WITTEN  Vt  H.A.WTTS  AND  L.F.SHAMPINE 
MNOIA  LAKMUTOtlES 
ALMMJERQUE.NEU  MEXICO 

M(F45  IS  MIMANILV  DESIGNED  TO  SOLVE  NON-STIFF  AND  MILDLY  STIFF 
OIFFEXENTIAL  EOUATIONS  WEN  DEEIVATIVE  EVALUATIONS  ARE  INEXPENSIVE. 
RKF4S  SHOULD  GENERALLY  NOT  BE  USED  UHEN  THE  USER  IS  DEMANDING 
HIGH  ACCURACY. 

AMTRACT 

SUSROUTINE  RKF4S  INTEGRATES  A  SYSTEM  OF  NEON  FIRST  ORDER 
ORDINARY  DIFFERENTIAL  EOUATIONS  OF  THE  FORM 

DY(I)/DT  ■  F(T.Y<1).Y(2).....T(NEMi)) 

WERE  THE  Y(I>  ARE  GIVEN  AT  T  . 

TYPICALLY  TNE  SUMQUTINE  IS  USED  TO  INTEGRATE  FROM  T  TO  TOUT  BUT  IT 
CAN  SE  USED  AS  A  ONE-STEP  INTEGRATOR  TO  ADVANCE  THE  SOLUTION  A 
SINGLE  STEP  IN  THE  DIRECTION  OF  TOUT.  ON  RETURN  THE  PARAMETERS  IN 
TNE  CALL  LIST  ARE  SET  FOR  CONTINUING  THE  IHTEGRATION.  THE  USER  HAS 
ONLY  TO  CALL  RKF45  AGAIN  (AMO  PERHAPS  DEFINE  A  NEW  VALUE  FOR  TOUT). 
ACTUALLY,  REF45  IS  AN  INTERFACING  ROUTINE  WHICH  CALLS  SUBROUTINE 
RKFS  FOR  THE  SOLUTION.  RKFS  IN  TWN  CAL.S  SUBROUTINE  FEHL  WHICH 
COMPUTES  AN  APPROXIMATE  SOLUTION  OVER  ONE  STEP. 

RICP4S  USES  THE  RUNGE-KUTTA-FEHLBtRG  (4,5)  METHOD  DESCRIBED 
IN  TNE  REFERENCE 

E.FEHLBERG  ,  LOW-ORDER  CUSSICAL  RUNGE-KUTTA  FORMULAS  WITH  STEPSIZE 
CONTROL  ,  NASA  TR  R-315 

THE  PERFORMANCE  OF  RKF4S  IS  ILLUSTRATED  IN  THE  REFEREHCE 
L.F.SHANPIW,H.A.UATTS,S.DAVENPORT,  SOLVING  NON-STIFF  ORDINARY 
DIFFERENTIAL  EOUATIONS-THE  STATE  OF  THE  ART  , 

SANDIA  LABORATORIES  REPORT  SAWTS-OISZ  , 

TO  APPEAR  IN  SIAM  REVIEW. 


THE  PARAMETERS  REPRESENT- 

F  —  SUBROUTINE  F(T,Y,YP)  TO  EVALUATE  DERIVATIVES  YP(I)^Y(I)/DT 
NEON  -  HUMBER  OF  EQUATIONS  TO  BE  INTEGRATED 
Y(*)  -  SOLUTION  VEaOR  AT  T 
T  --  INDEPENDENT  VARIABLE 

TOUT  -  OUTPUT  POINT  AT  WICH  SOLUTION  IS  DESIRED 
RELERR.ABSERR  —  RELATIVE  AND  ABSOLUTE  ERROR  TOLERANCES  FOR  LOCAL 
ERROR  TEST.  AT  EACH  STEP  THE  CODE  REQUIRES  THAT 
ABS( LOCAL  ERROR)  .LE.  RELERR*ABS(y)  ♦  ABSERR 
FOR  EACH  COMPONENT  OF  THE  LOCAL  ERROR  AND  SOLUTION  VECTORS 
IFLA6  —  INDICATOR  FOR  STATUS  OF  INTEGRATION 
W0RK(*)  —  ARRAY  TO  NOLO  INFORMATION  INTERNAL  TO  RKF45  WHICH  IS 
MCESSARY  FOR  SUBSEQUENT  CALLS.  MUST  BE  DIMENSIONED 
AT  LEAST  3«6*NEQN 

IW0RK(*}  -  INTEGER  ARRAY  USED  TO  HOLD  INFORMATION  INTERNAL  TO 
RKF45  WHICH  IS  NECESSARY  FOR  SUBSEQUENT  CALLS.  MUST  BE 
DIMENSIONED  AT  LEAST  5 


FIRST  CALL  TO  RKF45 

THE  USER  MUST  PROVIDE  STORAGE  IN  HIS  CALLING  PROGRAM  FOR  THE  ARRAYS 
IN  TNE  CALL  LIST  -  Y(NEQN)  ,  U0RK(3«6*NEQN)  .  lUORK(S)  , 
DECLARE  F  IN  AN  EXTERNAL  STATEMENT,  SUPPLY  SUBROUTINE  F(T,Y,YP)  ANO 


439 


OOUUUUUUUOUU  U,U  UUUUUUOUUCJUUUUUUUUUUOOUUWOUUUUUUUUUUUUUUUUUUUUVUUUCI 


Program  RKF45.F0R 


IMITIALIS  THE  raiLOUIHO  PARMCTERS- 

HNH  NUMER  OF  EaUATIQNS  TO  K  IHTEGRATEO.  (HEON  .GE.  1) 

T(*)  ••  VECTOR  OF  IHITIAL  CQNOITIQMS 
T  •*  START1H6  POIHT  OF  INTEGRATION  .  MUST  RE  A  VARIAILE 
TOUT  ••  OUTPUT  POINT  AT  HHICN  SOLUTION  IS  DESIRED. 

T-TOUT  IS  ALLOUEO  ON  THE  FIRST  CALL  ONLY,  IN  UHICH  CASE 
RKFA5  RETURNS  WITH  IFLA6-2  IF  CONTINUATION  IS  POSSIBLE. 
RELERR.ARSERR  ->  RELATIVE  AND  ASSOLUTE  LOCAL  ERROR  TOLERANCES 

WHICH  NUST  BE  NON-NEGATIVE.  RELERR  NUST  BE  A  VARIABLE  WHILE 
ABSERR  NAT  BE  A  CONSTANT.  THE  CODE  SHOULD  NORNALLY  HOT  BE 
UBEO  WITH  REUTIVE  ERROR  CONTROL  SNALLER  THAN  ABOUT  1.E-8  . 
TO  AVOID  LINITIHG  PRECISION  DIFFICULTIES  THE  CODE  REQUIRES 
KLERR  TO  BE  LARGER  THAN  AH  INTERNALLY  CONFUTED  RELATIVE 
ERROR  PARANETER  WHICH  IS  NACNIHE  DEPENDENT.  IN  PARTICULAR, 
PURE  ABSOLUTE  ERROR  IS  HOT  PERNITTED.  IF  A  SNALLER  THAN 
ALLOWABLE  VALUE  OF  RELERR  IS  ATTENPTEO.  RKF45  INCREASES 
RELERR  APPROPRIATELY  AND  RETURNS  CONTROL  TO  THE  USER  BEFORE 
CONTINUING  THE  INTEGRATION. 

IFLA6  -  ♦1,-1  INDICATOR  TO  INITIALIZE  THE  CODE  FOR  EACH  NEW 
PROBLEN.  NORNAL  INPUT  IS  THE  USER  SHOULD  SET  IFLAG>-1 
ONLY  WHEN  ONE-STEP  INTEGRATOR  CONTROL  IS  ESSENTIAL.  IN  THIS 
CASE,  RKF45  ATTENPTS  TO  ADVANCE  THE  SOLUTION  A  SINGLE  STEP 
IN  THE  DIRECTION  OF  TOUT  EACH  TINE  IT  IS  CALLED.  SINCE  THIS 
NODE  OF  OPERATION  RESULTS  IN  EXTRA  CONFUTING  OVERHEAD,  IT 
SHOULD  BE  AVOIDED  UNLESS  HEEDED. 


OUTPUT  FRON  RKF45 

TI*Y  —  SOLUTION  AT  T 
r  -  LAST  POINT  REACHED  IN  INTEGRATION. 

IFLA6  -  2  -  INTEGRATION  REACHED  TOUT.  INDICATES  SUCCESSFUL  RETURN 
AND  IS  THE  NORNAL  NODE  FOR  CONTINUING  INTEGRATION. 

«-2  -  A  SINGLE  SUCCESSFUL  STEP  IN  THE  DIRECTION  OF  TOUT 
HAS  BEEN  TAKEN.  NORNAL  NODE  FOR  CONTINUING 
INTEGRATION  OK  STEP  AT  A  TINE. 

>  3  —  INTEGRATION  WAS  NOT  OONPLETED  BECAUSE  RELATIVE  ERROR 

TOLERANCE  WAS  TOO  SNALL.  RELERR  HAS  BEEN  INCREASED 
APPROPRIATELY  FOR  CONTINUING. 

■  4  -•  INTEGRATION  WAS  NOT  OONPLETBI  BECAUSE  NORE  THAN 
3000  DERIVATIVE  EVALUATIONS  WERE  NEEDED.  THIS 
IS  APPROXINATELT  500  STEPS. 

>  5  —  INTEGRATION  WAS  NOT  CONPLETEO  BECAUSE  SOLUTION 

VANISNB)  NAKING  A  PURE  RELATIVE  ERROR  TEST 
INPOSSIBLE.  NUST  USE  NON-ZERO  ABSERR  TO  CONTINUE. 
USING  THE  ONE-STEP  INTEGRATION  NODE  FOR  ONE  STEP 
IS  A  GOOD  WAY  TO  PROCEED. 

>  6  -  INTEGRATION  WAS  NOT  CONPLETEO  BECAUSE  REQUESTED 

ACCURACY  COULD  NOT  BE  ACHIEVED  USING  SNALLEST 
ALLOWABLE  STEPSIZE.  USER  NUST  INOIEASE  THE  ERROR 
TOLERANCE  BEFORE  CONTINUED  INTEGRATION  CAN  BE 
ATTENPTEO. 

-  7  —  IT  IS  LIKELY  THAT  RKF45  IS  INEFFICIENT  FOR  SOLVING 
this  PROBLEN.  TOO  NUCH  OUTPUT  IS  RESTRICTING  THE 
NATURAL  STEPSIZE  CHOICE.  USE  THE  ONE-STEP  INTEGRATOR 
NODE. 

>  8  -  INVALID  INPUT  PARANETERS 

THIS  INDICATOR  OCCURS  IF  ANY  OF  THE  FOLLOWING  IS 
SATISFIED  -  NEON  .LE.  0 

T>TOUT  AND  I  FLAG  .HE.  4^1  OR  -1 
RELERR  OR  ABSERR  .LT.  0. 

IFLAG  .EQ.  0  OR  .LT.  -2  OR  .GT.  8 
UaRK(*),IWORK(*)  --  INFORNATION  WHICH  IS  USUALLY  OF  NO  INTEREST 
TO  THE  USER  BUT  NECESSARY  FOR  SUBSEQUENT  CALLS. 
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Program  RKF45.FOR 


C  W0RK(1).....UQmC(NEQN)  CONTAIM  THE  FIRST  DERIVATIVES 

C  OF  THE  SOLUTION  VECTOR  Y  AT  T.  UQRK(NEQiKl)  CONTAINS 

C  THE  STEPSIZE  H  TO  K  ATTEMPTED  ON  THE  NEXT  STEP. 

C  lUORKd)  CONTAINS  THE  DERIVATIVE  EVALUATION  COUNTER. 

C 

C 

C  SUNSEOUENT  CALLS  TO  RKF4S 
C 

C  SURROUTINE  RKFAS  RETURNS  WITH  ALL  INFORMATION  NEEDED  TO  CONTINUE 
C  THE  INTE6RATI0N.  IF  THE  INTEORATION  REACHED  TOUT.  THE  USER  NEED  ONL 
C  DEFINE  A  NEU  TOUT  AND  CALL  RKF45  AGAIN.  IN  THE  ONE-STEP  INTEGRATOR 
C  MODE  (lFLAQ«-2>  TNE  USER  MUST  KEEP  IN  NINO  THAT  EACH  STEP  TAKEN  IS 

C  IN  THE  DIRECTION  OF  THE  CURRENT  TOUT.  UPON  REACHING  TOUT  (INDICATED 

C  ET  CHANGING  IFLAG  TO  2). TNE  USER  MUST  THEN  DEFINE  A  NEW  TOUT  AND 

C  RESET  IFLAG  TO  -2  TO  CONTINUE  IN  THE  ONE-STEP  INTEGRATOR  NODE. 

C 

C  IF  TNE  INTEGRATION  WAS  NOT  COMPLETED  BUT  THE  USER  STILL  WANTS  TO 
C  CONTINUE  (IFLAG>3,4  CASES),  HE  JUST  CALLS  RKF45  AGAIN.  WITH  IFU6>3 
C  THE  RELERR  PARAMETER  HAS  BEEN  ADJUSTED  APPROPRIATELY  FOR  CONTINUING 
C  THE  INTEGRATION.  IN  THE  CASE  OF  IFLAG«4  THE  FUNCTION  COUNTER  WILL 
C  BE  RESET  TO  0  AND  ANOTHER  3000  FUNCTION  EVALUATIONS  ARE  ALLOWED. 

C 

C  HOWEVER. IN  THE  CASE  IFLAG<,  THE  USER  MUST  FIRST  ALTER  THE  ERROR 
C  CRITERION  TO  USE  A  POSITI^  VALUE  OF  ABSERR  BEFORE  INTEGRATION  CAN 
C  PROCEED.  IF  HE  DOES  NOT.EXECUTION  IS  TERMINATED. 

C 

C  ALSO.IN  THE  CASE  IFLAIM,  IT  IS  NECESSARY  FOR  THE  USER  TO  RESET 
C  IFLAG  TO  2  (OR  -2  WHEN  THE  ONE-STEP  INTEGRATION  MODE  IS  BEING  USED) 

C  AB  WELL  AS  INCREASING  EITHER  ABSERR, RELERR  OR  BOTH  BEFORE  THE 

C  INTEGRATION  CAM  BE  CONTINUED.  IF  THIS  IS  HOT  DONE,  EXECUTION  WILL 

C  BE  TERMINATED.  THE  OCdlRREHCE  OF  IFLAG-6  IWICATES  A  TROUBLE  SPOT 

C  (SOLUTION  IS  CHANGING  RAPIDLY, SINGULARITY  NAY  BE  PRESENT)  AND  IT 
C  OFTEN  IS  INADVISABLE  TO  CONTINUE. 

C 

C  IF  IFLAG-7  IS  ENCOUNTERED,  TNE  USER  SHOULD  USE  THE  ONE-STEP 
C  INTEGRATION  NODE  WITH  THE  STEPSIZE  DETERMINED  BY  THE  CODE  OR 

C  CONSIDER  SWITCHING  TO  THE  ADAMS  CODES  DE/STEP, INTRP.  IF  THE  USER 

C  INSISTS  UPON  CONTINUING  THE  INTEGRATION  WITH  RKF45,  HE  MUST  RESET 
C  IFLAG  TO  2  BEFORE  CALLIHG  RKF45  AGAIN.  OTHERWISE.EXECUTION  WILL  BE 
C  TERMINATED. 

C 

C  IF  IPLA6>8  IS  OBTAINED,  INTEGRATION  CAN  NOT  BE  CONTINUED  UNLESS 
C  TNE  INVALID  INPUT  PARAMETERS  ARE  CORRECTED. 

C 

C  IT  SHOULD  BE  NOTED  THAT  THE  ARRAYS  WORK.IWORK  CONTAIN  INFORMATION 
C  REGUIRED  FOR  SUBSEQUENT  INTEGRATION.  ACCORDINGLY,  WORK  AND  IWORK 
C  SHOULD  NOT  BE  ALTERED. 

C 

C  WORK  -  DfMnsiorMd  for  Mn  NEON  •  500 
C 

INTEGER  NEaN,IFUG,IU0RK(5) 

DOUBLE  PRECISION  Y(NEON),T,T0UT,RELERR,ABSERR.UORK(11000) 

IF  COMPILER  CHECKS  SUBSCRIPTS,  CHANGE  U0RK(1)  TO  U0RK(3^*NEQN) 

EXTERNAL  F 

INTEGER  K1,K2,K3,K4,K5,K6,K1N 


COMPUTE  INDICES  FOR  THE  SPLITTING  OF  THE  WORK  ARRAY 

K1H>NEQN-»1 

K1«K1M*1 

K2>X1«NEQN 

K3«K2-»NE0N 
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Program  flKF45.F0R 


IC4>IC3«iaQN 

IC5-IC4<»NfCW 

ttNCSHKQN 

THIS  IMTCKFACING  MUTINC  MERELY  RELIEVES  THE  USER  OF  A  LONG 
CALLING  LIST  VIA  THE  SPLITTING  APART  OF  TUO  WORKING  STORAGE 
ARRAYS.  IF  THIS  IS  HOT  COMPATIBLE  WITH  THE  USERS  COMPILER. 

HE  MUST  USE  RKFS  DIRECTLY. 

CALL  RKFS(F.NEQN,Y.T,TQUT.RELERR.ABSERR.1FU6,U0RK(1),U0RK(K1H), 

1  HOIMC<K1).UORK(K2),UaRK(K3),WORK(K4>,WORK(K5).HORK(K6), 

2  W0RK(K6«^1 ) ,  lUORKd  ),  IU0RK(2) .  1U0RK(3).  IW0RK(4) .  lUORKlS)) 


RETURN 

END 

SUBROUTINE  RKFS(F,NEQN,T,T.T0UT,RELERR,ABSERR,IFUG,YP.H,F1,F2,F5, 
1  F4.FS,SAVRE.SAVAE.NFE,K0P.INIT,JFLAG,KFLA6) 

FEHLBERG  FOURTH- FIFTH  ORDER  RUNGE-KUTTA  METHOD 


RKFS  INTEGRATES  A  SYSTEM  OF  FIRST  ORDER  ORDINARY  DIFFERENTIAL 
EGUATIONS  AS  DESCRIBED  IN  THE  COMMENTS  FOR  RKF45  . 

THE  ARRAYS  YP,F1,F2.F3.F4.AND  F5  (OF  DIMENSION  AT  LEAST  NEON)  AND 
THE  VARIABLES  H.SAVRE.SAVAE.NFE.KOP.IHIT.JFLAG.AND  KFUG  ARE  USED 
INTERNALLY  BY  THE  CODE  AND  APPEAR  IN  THE  CALL  LIST  TO  ELIMINATE 
LOCAL  RETENTION  OF  VARIABLES  BETWEEN  CALLS.  ACCORDINGLY.  THEY 
SHOULD  NOT  BE  ALTERED.  ITEMS  OF  POSSIBLE  INTEREST  ARE 
YP  •  DERIVATIVE  OF  SOLUTION  VECTOR  AT  T 
N  •  AN  APPROPRIATE  STEPSIZE  TO  BE  USED  FOR  THE  NEXT  STEP 
HFE-  COUNTER  ON  THE  NUMBER  OF  DERIVATIVE  FIMCTION  EVALUATIONS 


LOGICAL  HFAILD, OUTPUT 

INTEGER  NEGN.IFLAG.NFE.KOP.INIT.JFUG.KFLAG 

DOUBLE  PRECISION  y(NEQN),T.TOUT,RELERR,ABSERR,H,YP(HEQN). 

1  F1(NEQN),F2<NEON>,F3(NEON).F4(NEaN),F5(NEQN>.SAVRE. 

2  SAVAE 

EXTERNAL  F 

DOUBLE  PRECISION  A.AE.DT.EE.EEOET.ESTTOL.ET.HMIN.REMIN.RER.S, 
1  SCALE,T0L,T0LN,U26,EPSP1,EPS.YPK 

INTEGER  K.MAXNFE.MFLAG 

DOUBLE  PRECISION  DABS.OMAXI.ONINl.OSIGN 

RENIN  IS  THE  MINIMUM  ACCEPTABLE  VALUE  OF  RELERR.  ATTEMPTS 
TO  OBTAIN  HIGHER  ACCURACY  WITH  THIS  SUBROUTINE  ARE  USUALLY 
VERY  EXPENSIVE  AND  OFTEN  UNSUCCESSFUL. 

DATA  RENIH/1 .00-12/ 


THE  EXPENSE  IS  CONTROLLED  BY  RESTRICTING  THE  NUMER 
OF  FUNCTION  EVALUATIONS  TO  BE  APPROXIMATELY  NAXNFE. 
AS  SET,  THIS  CORRESPONDS  TO  ABOUT  500  STEPS. 

DATA  NAXNFE/2000000/ 


CHECK  INPUT  PARAMETERS 
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Program  RKF45.F0R 


IF  (NEON  .LT.  1)  GO  TO  10 

IF  ((RELERR  .LT.  0.000)  .OR.  (ABSERR  .LT.  O.ODO))  GO  TO  10 
NFLAG>IASS(IFLAG) 

IF  ((NFLAG  .EO.  0)  .OR.  <NFLAG  .GT.  8))  GO  TO  10 
IF  (NFUG  .HE.  1)  GO  TO  20 

FIRST  CALL,  COMPUTE  MACHINE  EPSILON 

EPS  «  1.000 
5  EPS  >  EPS/2.000 
EPSP1  •  EPS  1.000 
IF  (EPSP1  .GT.  1.000)  GO  TO  5 
U26  ■  26.0O0*EPS 
GO  TO  SO 

INVALID  INPUT 
10  IFLAG-8 
RETURN 

CHECK  CONTINUATION  POSSIBILITIES 

20  IF  ((T  .EQ.  TOUT)  .AND.  (KFUG  .HE.  3))  GO  TO  10 
IF  (NFLAG  .NE.  2)  GO  TO  25 

IFLAG  ■  *2  OR  -2 

IF  ((KFLAG  .EO.  3)  .OR.  (INI  '  .EO..  0))  GO  TO  45 
IF  (KFUG  .EQ.  4)  GO  TO  40 

IF  ((KFLAG  .EQ.  5)  .AND.  (ABSERR  .EO.  0.000))  GO  TO  30 
IF  ((KFUG  .EO.  6)  .AND.  (RELERR  .LE.  SAVRE)  .AND. 

1  (ABSERR  .LE.  SAVAE))  GO  TO  30 
GO  TO  SO 

IFLAG  «  3, 4, 5, 6, 7  OR  8 
23  IF  (IFLAG  .EQ.  3)  GO  TO  45 
IF  (IFUG  .EQ.  4)  GO  TO  40 

IF  ((IFUG  .EQ.  5)  .AHO.  (ABSERR  .GT.  0.000))  GO  TO  45 

INTEGRATION  CANNOT  BE  CONTINUED  SINCE  USER  010  NOT  RESPONO  TO 
THE  INSTRUCTIONS  PERTAINING  TO  IFLAG=5,6,7  OR  8 
30  STOP 

RESET  FUNCTION  EVALUATION  COUNTER 
40  NFE>0 

IF  (NFUG  .EO.  2}  GO  TO  50 

RESET  FLAG  VALUE  FROM  PREVIOUS  ULL 
45  IFUG*JFUG 

IF  (KFUG  .EQ.  3)  NFUGsIABSdFLAG) 

SAVE  INPUT  IFUG  AND  SET  CONTINUATION  FLAG  VALUE  FOR  SUBSEQUENT 
INPUT  CHECKING 
50  JFUG«IFUG 
KFUG«0 

SAVE  RELERR  ANO  ABSERR  FOR  CHECKING  INPUT  ON  SUBSEQUENT  ULLS 

SAVRE>RELERR 

SAVAE>A8SERR 

RESTRICT  RELATIVE  ERROR  TOLERANCE  TO  BE  AT  LEAST  AS  LARGE  AS 
2*EPS'HiEMIN  TO  AVOID  LIMITING  PRECISION  DIFFICULTIES  ARISING 
FROM  IMPOSSIBLE  ACCURACY  REQUESTS 

RER*2.000*EPS'^RENIN 
IF  (RELERR  .GE.  RER)  GO  TO  55 
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Proflrani  RKF45.FOR 


C  RELATIVE  ERROR  TOLERANCE  TOO  SMALL 
RELERR^ER 
1FLA6-3 
ICFLAG>3 
RETURN 
C 

55  0T»T0UT-T 

IF  (NFLA6  .EO.  1)  60  TO  60 
IF  (INIT  .EQ.  0)  60  TO  65 
60  TO  80 

INITIALIZATION  -- 

SET  INITIALIZATION  COMPLETION  INDICATOR, INIT 
SET  INDICATOR  FOR  TOO  MANY  OUTPUT  POINTS.KOP 
EVALUATE  INITIAL  DERIVATIVES 
SET  COUNTER  FOR  FUNCTION  EVALUATIONS.NFE 
ESTIMATE  STARTIN6  STEPSIZE 

60  INIT>0 
K0P>0 
C 

A«T 

CALL  F(A,V,YP) 

NFE*1 

IF  (T  .NE.  TOUT)  60  TO  65 
IPLA6*2 
RETURN 
C 
C 

65  INIT«1 
IM>ABS<DT) 

T0LN«0. 

DO  70  Kal.NEON 

TOL«RELERR*DABS( Y(K) )^ABSERR 
IF  <TOl  .LE.  0.)  60  TO  70 
TOLN«TOL 
YPKiOABS(YP<K) > 

IF  <YPIC*H**5  .6T.  TOL)  H»<TOL/YPK)**0.200 
70  CONTINUE 

IF  (TaN  .LE.  0.000)  H-O.OOO 
N>0MAX1(H,U26*0MAX1(DABS(T),DABS(DT))) 

JFLA&>ISI6N(2,IFLAC) 

C 

C 

C  SET  STEPSIZE  FOR  INTEORATION  IN  THE  DIRECTION  FROM  T  TO  TOUT 
C 

80  HaOSICN(H,OT) 

C 

C  TEST  TO  SEE  IF  RKF45  IS  BE INC  SEVERELY  IMPACTED  BY  TOO  MANY 
C  OUTPUT  POINTS 

C 

IF  (DABS(H)  .6E.  2.000^ABS<DT))  K0P>K0P«1 
IF  (KOP  .NE.  100)  CO  TO  85 
C 

C  UNNECESSARY  FREQUENCY  OF  OUTPUT 

IC0P«0 
IFLAC-7 
RETURN 
C 

85  IF  (DABS(DT)  .6T.  U26*0ABS{T))  GO  TO  95 
C 

C  IF  TOO  CLOSE  TO  OUTPUT  POINT, EXTRAPOLATE  AMO  RETURN 
C 
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Program  RKF4S.F0R 


DO  90  K-1,NEQH 
90  Y<IC)»y(IC>*0T*YP(K) 
A>T0UT 

CALL  F<A,Y,YP) 
NFE-NFE-^1 
00  TO  300 


INITIALIZE  OUTPUT  POINT  INDICATOR 
95  OUTPUT-  .FALSE. 

TO  AVOID  PREMATURE  UNDERFLOU  IN  THE  ERROR  TOLERANCE  FUNCTION, 
SCALE  THE  ERROR  TOLERANCES 

SCALE-Z.ODO/RELERR 

AE>SCALE*A8SERR 


STEP  8Y  STEP  INTEGRATION 
100  HFAILD-  .FALSE. 

SET  SMALLEST  ALLOWABLE  STEPS I ZE 
NNIIMJ26«0ABS(T) 

ADJUST  STEPSIZE  IF  NECESSARY  TO  HIT  THE  OUTPUT  POINT. 

LOOK  AHEAD  TWO  STEPS  TO  AVOID  DRASTIC  CHANGES  IN  THE  STEPSIZE  AND 
THUS  LESSEN  THE  IMPACT  OF  OUTPUT  POINTS  ON  THE  CODE. 

DT-TOUT-T 

IF  <0ABS(0T}  .GE.  2.Q00^ABS(H))  GO  TO  200 
IF  (OABS(OT)  .GT.  OABS(H))  GO  TO  ISO 

THE  KXT  SUCCESSFUL  STEP  WILL  COMPLETE  THE  INTEGRATION  TO  THE 
OUTPUT  POINT 

OUTPUT-  .TRUE. 

H-DT 

GO  TO  200 
C 

150  H-0.500^T 
C 
C 
C 

C  CORE  INTEGRATOR  FOR  TAKING  A  SINGLE  STEP 
C 

C  THE  TOLERANCES  HAVE  BEEN  SCALED  TO  AVOID  PREMATURE  UNDERFLOW  IN 
C  COMPUTING  THE  ERROR  TOLERANCE  FUNCTION  ET. 

C  TO  AVOID  PROBLEMS  WITH  ZERO  CROSSINGS.RELATIVE  ERROR  IS  MEASURED 
C  USING  THE  AVERAGE  OF  THE  MAGNITUDES  OF  THE  SOLUTION  AT  THE 
C  BEGINNING  AND  END  OF  A  STEP. 

C  THE  ERROR  ESTIMATE  FORMULA  HAS  BEEN  GROUPED  TO  CONTROL  LOSS  OF 
C  SIGNIFICANCE. 

C  TO  DISTINGUISH  THE  VARIOUS  ARGUMENTS,  H  IS  NOT  PERMITTED 
C  TO  BECOME  SMALLER  THAN  26  UNITS  OF  ROUNDOFF  IN  T. 

C  PRACTICAL  LIMITS  ON  THE  CHANGE  IN  THE  STEPSIZE  ARE  ENFORCED  TO 

C  SMOOTH  THE  STEPSIZE  SELECTION  PROCESS  AND  TO  AVOID  EXCESSIVE 

C  CHATTERING  ON  PROBLEMS  HAVING  DISCONTINUITIES. 

C  TO  PREVENT  UNNECESSARY  FAILURES,  THE  CODE  USES  9/10  THE  STEPSIZE 
C  IT  ESTIMATES  WILL  SUCCEED. 

C  AFTER  A  STEP  FAILURE,  THE  STEPSIZE  IS  NOT  ALLOWED  TO  INCREASE  FOR 
C  THE  NEXT  ATTEMPTED  STEP.  THIS  MAKES  THE  CODE  MORE  EFFICIENT  ON 
C  PROBLEMS  HAVING  DISCONTINUITIES  AND  MORE  EFFECTIVE  IN  GENERAL 
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Program  RKF45.F0R 


SINCE  LOCAL  EXTRAPOLATION  IS  BEING  USED  AND  EXTRA  CAUTION  SEEMS 
WARRANTED. 


TEST  NUMKR  OF  DERIVATIVE  FUNCTION  EVALUATIONS. 

IF  OKAY, TRY  TO  ADVANCE  THE  INTEGRATION  FROM  T  TO  Ti-H 

200  IF  (NFE  .LE.  NAXNFE)  GO  TO  220 

TOO  MUCH  WORK 
IFLA6«A 
KFLAG>A 
RETURN 

ADVANCE  AN  APPROXIMATE  SOLUTION  OVER  ONE  STEP  OF  LENGTH  H 

220  CALL  FEHL<F,NE0N,Y,T.H.YP,F1,F2,F3.F4,F5,F1) 

NFE-NFE-^5 

COMPUTE  AND  TEST  ALLOUABLE  TOLERANCES  VERSUS  LOCAL  ERROR  ESTIMATES 
AND  ROnVE  SaLIHG  OF  TOLERANCES.  MOTE  THAT  RELATIVE  ERROR  IS 
MEASURED  WITH  RESPECT  TO  THE  AVERAGE  OF  THE  MAGNITUDES  OF  THE 
SOLUTION  AT  THE  BEGINNING  AND  END  OF  THE  STEP. 

EEOET-O.ODO 
DO  250  K>1.NEQN 
ETaOABS<V(K)  )«OASS(F1 (K) HAE 
IF  (ET  .GT.  0.000)  GO  TO  240 

INAPPROPRIATE  ERROR  TOLERANCE 

IFLAG>5 

RETURN 

240  EE>«ABS((>2090.000*YP(K)-»(21970.000«F3(K)-15048.000*F4(K)»4^ 

1  (22S28.000*F2(K)-27360.000*F5(K))) 

250  EEOET>OMAXI(EEOET,EE/ET) 

ESTTOL>OABS(N)*EEOET*SCALE/752400.000 

IF  (ESTTOL  .LE.  1.000)  GO  TO  260 


UNSUCCESSFUL  STEP 

REDUCE  THE  STEPSIZE  ,  TRY  AGAIN 

THE  DECREASE  IS  LIMITED  TO  A  FACTOR  OF  1/10 


HFAILO*  .TRUE. 

OUTPUT-  .FALSE. 

S-0.1D0 

IF  (ESTTOL  .LT.  S9049.0DO)  S-0.9D0/ESTTOL**0.200 
H«S*H 

IF  (DABS(H)  .GT.  HMIN)  GO  TO  200 

REQUESTED  ERROR  UNATTAINABLE  AT  SMALLEST  ALLOWABLE  STEPSIZE 

IFLA6-6 

KFLAG-6 

RETURN 


SUCCESSFUL  STEP 

STORE  SOLUTION  AT  T-»H 

AND  EVALUATE  DERIVATIVES  THERE 

260  T-T+H 

00  270  K-1,NEON 
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Proaram  RKF45.F0R 


270  T(K)>FUK) 
A«T 

CALL  FCA.Y.YP) 
HFE>MIFE-»1 


CHOOSE  HEXT  STEPSIZE 
THE  IHCHEASE  IS  LIMITED  TO  A  FACTOR  OF  5 
IF  STEP  FAILURE  MAS  JUST  OCCURRED,  HEXT 
STEPStZE  IS  MOT  ALLOWED  TO  IMCREASE 

S^.ODO 

IF  (ESTTOL  .GT.  1.8a95«a>*4)  S>0.9DO/ESTTOL**0.200 
IF  (HFAILO)  S-OMIMKS,  1.000) 
IM>SI6M(DMAX1(S*0ABS(M),HNIM),H) 

EMD  OF  CORE  IHTEGRATOR 


SHOULD  HE  TAKE  ANOTHER  STEP 

IF  (OUTPUT)  GO  TO  300 
IF  (IFLAG  .GT.  0)  GO  TO  100 


INTEGRATION  SUCCESSFULLY  COMPLETED 

ONE'STEP  MODE 
IPLA6-2 
RETURN 
C 

C  INTERVAL  NODE 

300  T>T0UT 
IPLAG-2 
RETURN 
C 

END 

SURROUTINE  FEHL(F,NEaN,Y,T,H,YP,F1 ,F2,F3,F4,FS,S) 

C 

C  FEHLBERG  FOURTH-FIFTH  ORDER  RUNGE-KUTTA  METHOD 

C 

C  FEHL  INTEGRATES  A  SYSTEM  OF  NEON  FIRST  ORDER 
C  ORDINARY  DIFFERENTIAL  EQUATIONS  OF  THE  FORM 
C  0Y(I)/0T-F(T,Y(1),  — ,Y(MEQM)) 

C  UNERE  THE  INITIAL  VALUES  Y(I)  AND  THE  INITIAL  DERIVATIVES 
C  TP(I)  ARE  SPECIFIED  AT  THE  STARTING  POINT  T.  FEHL  ADVANCES 
C  THE  SOLUTION  OVER  THE  FIXED  STEP  H  AND  RETURNS 
C  THE  FIFTH  ORDER  (SIXTH  ORDER  ACCURATE  LOCALLY)  SOLUTION 
C  APPROXINATION  AT  T-»N  IN  ARRAY  S(I). 

C  FI,  — ,F5  ARE  ARRAYS  OF  DIMENSION  NEQN  WHICH  ARE  NEEDED 

C  FOR  INTERNAL  STORAGE. 

C  THE  FCRMUUS  HAVE  BEEN  GROUPED  TO  CONTROL  LOSS  OF  SIGNIFICANCE. 
C  FEHL  SHOULD  BE  CALLED  WITH  AN  H  NOT  SMALLER  THAN  13  UNITS  OF 

C  ROUNDOFF  IN  T  SO  THAT  THE  VARIOUS  INDEPENDENT  ARGUMENTS  CAN  BE 

C  DISTINGUISHED. 

C 

C 

INTEGER  NEON 

DOUBLE  PRECISION  Y(NE0N),T,H,YP(NE0N},F1(NE0N).F2(NEQN). 

1  F3(NE0N),F4(NEaN),FS(NEQN),S(NE0N) 

C 

DOUBLE  PRECISION  CH 
INTEGER  K 

C... 

EXTERNAL  F 
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CMH/4.Q00 
00  221  Kal.MCON 

221  rSIKI-tdO^CHnPCIC) 

CALL  F(T-»CH.F5.P1) 

ClM.QOO*N/32.aOO 
00  222  KalfNEON 

222  F5(K)-Y(K)«Ctl*(YP(K)«3.Q00*F1(K)) 

CALL  F(T«3.0DO*H/8.0OO,FS,F2) 

CIMI/2197.000 
OO  2S  Kal.MECW 

223  FS(K>>Y(IC)«CII*(1«32.QOOnP(K)+(7296.0DO*F2(IC)-7200.000*F1(IC))) 
CALL  F{Y«12.CO0*H/13.0OO,FS.F3) 

CII>N/4104.0DO 
00  224  Kal.NEQN 

224  F5(IC>«Y(K)«CH*((8341 .000*YP(K)*845.000*F3(K»4' 

1  (2944O.QO0*F2(IC)-32832.0DO*F1(K))) 

CALL  F(T-HI.FS,F4} 

CN-M/20520.G00 
DO  225  K«1,NE0N 

225  FI  (IC)>Y(K)«C1I*«  •6080.0D0nP(K)«(9295 .000*F3(IO- 

1  5443.000*F4(K)))4-(41040.0DO*F1(K}*28352.a>0*F2(K»> 

CALL  F<T-MI/2.0DO.F1.F5) 

COMPUTE  APPOONINATE  SOLUTION  AT  T«H 

CN-H/7618050.000 
00  230  K-I.NEON 

230  S(K)>Y(K>«CI(*<(902880.QOOnp(K)«<38S5735.000*F3(K}- 

1  137124».000*F4(K}})-»(3953«64.0DO*P2(K)4^ 

2  277020.aOO*F5(K)» 

•ETUm 

END 


APPENDED  C 

Pulmoiiary  Model  Computer  Programs 
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Appendix  C  -  1 
Tissue  Model  -  Part  1 


PROGRAM  T188FCM 

C  This  proerM  calculatts  ttt*  Fractional  Capacity  of  lung  parcnchyuM 
C  for  a  givan  PraaaMra  •  Fractional  VoltJMt  curva  for  a  ntchanical  unit 
c  by  adriing  tha  affacta  of  tarainal  bronchi  cloaing  and  opening. 

OlNtiaiog  COF( lOO), FVtinCSOO). FVtaxlSOO) .SFVcttKIOO) 

C  CONKM  STATEMEbTS  FOR  SimOUTINE  lOOELCS 
IRTESER  IMP,  OUT.  PLT 
INTESER  CRT,  LUOUT,  LUIN,  LUPLT 
CtMRACTER*T  lEEP 
^'^ARACTER*aO  ITITLE 
c«ARACTER*64  HAIiP.IMOUT.IMPLT 
CONMOM  /DEVS/  LUTRM,  LUIN,  LUOUT,  LUPLT 
COMMON  /CURSOR/  REEP 

CONNOR  /LARELS/  ITITLE,  NAINP,  NAOUT,  MAPLT 

C  SETUP  THE  OUTPUT  FILE 
CRT  ■  0 

CALL  IOOECLS(0,1,0) 

C  CALCUUTE  THE  EXHALATION  P-FV  CURVE  FOR  THE  MECHANICAL  UNIT 

Oafina  tha  noraal  distribution  of  closing  pressures 

Paaan  ■  *0.8  iPwan  is  the  asan  value  of  the  closing  pressures 
SIGMA  ■  0.5  ISIGNA  is  the  Standard  Deviation  of  the  distribution 
SIGMA  •  0.8  for  the  inhalation  distribution 

Oafina  tha  FV  curva  for  tha  Mechanical  unit  when 
all  Taminal  Rronchi  are  open 


Pzaro  «*S.O 
Phalf  a  5.0 

ALPHA  a  .5/(Phalf*Pzero) 

SETA  a  (16*ALPHA*a3)/27 

FVSsKP)  a  ALPHAa(P-Pzero)  -  8ETAa(P-Phalf )**3  for  P>Phalf 
FVImKP)  a  ALPHA*('*>Pzero)  for  P<Phalf 

Divide  the  FVA  curva  into  NMAX-1  intervals  of  DPe  width,  the  Pressue  Range 
is  2.5*SIGMA  on  each  side  of  the  mean  closing  pressure  (PM). 

Nnax  a  21 

Prwtge  a  2a(2.5*SIGNA) 

OPa  a  prange/CHnaz-l) 

The  range  is  bounded  by  Pnaxe  and  Pmine. 

PMSxe  a  Peiean  *  Prange/2 
PMine  a  PMean  •  Prange/2 

Define  a  variable  CDF  at  the  end  of  each  interval, 

CDF  a  CuMilative  Distribution  Function  of  the  closing  pressures. 


URITE(0,10) 

10  FQRMAT('  ') 

t«ITE(0,1) 

1  FORNATC'  N  Pcc  COF(N)') 

2  F0RMAT(5X,I4,4X.F6.2,4X.F6.3) 
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^  •  pmm 
00  100  N  •  Mwx.l.-I 
U  ■  (Oec  •  PMan)/  SIGNA 
C0F(N>  •  (ERF(U)  *  1)/2.0 
MITE(0,2)  N.Fcc.COFCN) 

100  Fee  ■  Pee  ■  OP* 

C 

PMJSE'PAUSE  AFTER  THE  CALCULATION  OF  THE  COF' 

C 

C  Caleulate  th«  FVtU  in  the  region  where  Teraiinal  Bronchi  are  cloeing 
C 

««ITE(0,3) 

3  F0RMAT('  PRESS  FTB  OPEH  FVau  H  FVtex  FVepi  SFVc 
Xtb  PVotbO 

A  FQRNAT(2X,F6.2.2X.F6.2,7X,F6.3,3X,I2,2X.F6.3,2X.F6.3,2X,F6.3.2X. 

XF6.3) 

C 

DPhalfe  ■  OPe/2  (Half  a  preasure  incraaent  DPe 

SFVctMHaax)  ■  0  ISumed  Fractional  Vol  of  Cloaed  Terminal  Bronchi 
C 

Naaxi  >  Hmax  •  1 

00  500  N  >  Naax1,1,*1 

P  ■  Pmine*(N-1)*OPe«OPhalfe  IP  >  averaoe  iweaaure  in  the  nth  interval 

FVHm  ■  ALPHA*(P-Pxero) 

IF(P.6T.Phalf)  THEN  FVHu  «  FVNu  -  BETA*(P-Phalf>**3 
C 

FVepi  >  FVHU*(CDF<N4l)  •  COF(N))  I  Fractional  voluM  of  gas  that  Cloaca 
C  during  thia  Preaaurc  Increment 

SFVctMN)  •  SFVctb<lf»1)  ♦  FVepi  I Staaead  Fractional  Voluae  of  all  acini 
C  with  Cloaad  Terminal  Bronchi 

C 

FVotb  >  FVau  *  COF(H)  I  Fractional  Volume  contribution  of 

C  acini  with  Open  Terminal  Bronchi 

C 

FVtex(N)  •  SFVctbfN)  *  FVotb  IFraetional  Volume  of  the  Tieaue 
C 

SOO  UR1TE(0,4)  P.C0F(N).FVmu,N.FVtex(N), FVepi, SFVetb(N),FVotb 

PAUSE'  PAUSE  AFTER  OUTPUT  OF  THE  FVtia  curve  where  TO  are  cloaed' 

C 

C  Complete  FVtex  curve  for  preeaurea  where  all  terminal  bronchi  are  open 
C 

Hm  Umax 

700  P>Paine  ♦<H-1)*0Pe  ♦OPhelfe 
FVau  ■  ALPKA*(P-Pzero) 

IF(P.6T.Phalf)  FVmu  »  FVmu  •  BETA*lP*Phalf)**3 
FVtex(N)  >  FVmu 
IF(FVmu.6T.0.9999)  GO  TO  1000 
H  «  Nr1 
GO  TO  700 
C 

1000  Nmaxte  >  N  i*r1  of  DPe  increments  in  the  FVtex  curve 
C 

JbO 

DO  1200  N>1,HmBXte 
J  ■  J^1 

IFfJ.LT.IO)  GO  TO  1100 
J>0 

PAUSE  'PAUSE  DURING  PRINT' 

1100  P>  Pmine  *  N<VPe  -  DPhalfe 
1200  URITE(0,9)  N,P,FVtex(N) 

9  F0RHAT(SX,I3,5X,F6.2,5X,F6.3) 

C 

C  Calculate  the  inhalation  FVtia  curve  (FVtin)  for  a  VC  inhalation. 

C  The  inhalation  curve  for  the  mechanical  unit  has  the  same  shape 
C  as  the  exhalation  curve 

C  and  all  the  P's  are  increased  by  an  equal  amount  of  hysteresis, 

C  DPhys.  The  opening  sequence  is  taken  to  be  the  opposite  of  the 
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C  clMlng  saquanc*;  tha  first  tanainal  bronchi  to  cloaa  ara  tha  last 
C  to  opan. 

SIGNA-O.a 
PMan-taaamS.O 
Ofhya^.O 
Pzaro^saro^OPhya 
Pha  I  f  "Pha  I  f  ♦OPhya 

Pranaa«2*(2.S*SI(iNA) 

DP1"Pranga/(NMUi- 1 ) 

DPIuilf1>DPi/2.0 
Paaxi^PiMamPranga/Z 
Pal  ni  >Piaaan*  Pranga/2 

fVtlrKD-FVtaxd) 

WITECO.USO) 

1450  FORNATC'  PRESS  FTB  OPEN  fVmt  H  FVtin  FVcpi  SFVc 
Xtb  FVotb') 

OO  1500  N>2.Nmx 

P  ■  Pafn1«(H-1)*OP{*OPhalf{  IP  ■  avaraga  prassure  in  the  nth  interval 
FVau  *  ALPHA*(P-Pzero) 

IF(P.6T.Phalf)  THEN  FVIau  «  FVau  •  BETA*(P-Phalf)**3 
SFVotb>COF(N)*FVlHU  ISuMd  FV  of  alt  open  TB 

FVt{n(N)aSFVotb»SFVctb(N)  iaumed  FV  aof  all  open  and  closed  TB 
1500  WR1TE(0,4)  P,C0F(N). FVau,N.FVt1n(N), FVcpi ,SFVctb<H),SFVotb 

PAUSE'  Pause  after  output  of  FVtin  curve  uhere  all  TB  have  just 
X  opanad' 

C 

C  Coaplata  FVtin  curve  for  pressures  uhere  all  terminal  bronchi  ara  open 
C 

H«  Umax 

1700  pipaini  •'■(N-1)*0Pi  -HiPhalfi 
FVNm  •  ALPHA*(P-Pzero) 

IF(P.GT.Phalf)  FVmu  >  FVmu  •  BETA*(P-Phalf)**3 
FVtinlN)  «  Fvmu 
IFlFVMu.GT. 0.9999)  GO  TO  1720 
N  »  N+l 
60  TO  1700 
C 

1720  Nmaxt{«N 

FVtin(Niaaxti)«1.0 

Pmaxti^P 

C 

J«0 

DO  1800  N«1,Nmaxti 
J  *  J«^1 

IF(J.LT.IO)  GO  TO  1750 
J«0 

PAUSE  'PAUSE  DURING  PRINT' 

1750  P«  Paini  *  N*0Pi  •  DPhalfi 
1800  URITE(0,9)  N,P,FVtin(N} 

C  INTERPOLATE  THE  INHALATION  CURVE  TO  SAME  NMAX  AS  THE  EXHALATION  CURVE 
CALL  INTERPlFVtin.Nmaxti ,0Pi ,Nmaxte,DPe) 

C  PRINT  THE  DATA  TO  AN  OUTPUT  FILE 

15  FORMAT  (1X,I4,3F9.2} 

16  F0RMAT(1X,F7.3,1X.F7.3) 

Pai  nt  i  >Pai  ni ‘HIPhal  f  e 
Paaxti>Paint  i4'(Nmaxta>  1  )*0Pe 
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WRITEdUOUT.IS)  HMXt«,P«inti,PMBXt<.OPhys 

DO  1900  M>1.NMXt* 

P-  Palnl  ♦  IM>P«  -  DPhalft 
1900  URITE(LU0UT.16)  P,FVt1n(N) 

00  2000  Nal.tkMXt* 

P«  Pa1rw«  •  OPhalfa 

2000  VKlTEdUOUT.IO)  P.FVtax(N) 

C 

END 

C _ 

C  THE  ERROR  FUNCTION 
FUNCTION  ERF(X) 

IFCX.LT.OOTHEN 

ERF-*GMNiP(.5,X**2> 

ELSE 

ERF«GM«P(.S.XM2) 

ENOIF 

RETURN 

END 

C _ 

c 

C  THE  6AHMA  FUNCTION 

FUNCTION  GMMP(A,X) 

IF(X.LT.0..0R.A.LE.0.>PAUSE 

IF(X.LT.A«1.)THEN 

CALL  QSER(6ANSER,A,X.CLN) 

GAMPaSANSER 

ELSE 

CALL  GCFiCAMNCF.A.X.GLN) 

GAMNPat.'GWMCF 

ENOIF 

RETURN 

END 

C _ 

C 

SUBROUTINE  GSER(GAMSER,A,X,GLN) 

PARAMETER  (1TNAX>100,  EPSa3.E-7) 

GLN  >  GAMILNU) 

IF(X.LC.O.)THEN 

IP(X.LT.O.)PAUSE 

GAMSERaO. 

RETURN 

ENDIF 

APaA 

SUNal./A 

DELaSUM 

00  11  Nal.ITMAX 
APaAPl'I. 

DELaOEL*X/AP 

SUNaSUN«OEL 

IF(ABS(DEL).LT.ABS(SUM}*EPS)GO  TO  1 
11  CONTINUE 

PAUSE  'A  too  largo,  ITHAX  too  small' 

1  6ANSER  a  SUN*EXP(-X«A*LOG(X)*GLN) 

RETURN 

END 

C _ 

c 

SUBROUTINE  6CF(GAMMCF.A,X,GLN) 

PARAMETER  (ITMAXa100,EP$a3.E-7) 
GLNaGAMMLN(A) 

GOLOaO. 
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Program  TISSFCM.FOR 


A0>1. 

A1«X 

MM). 

B1>1. 

MC-1. 

00  11  N>1.IT)MX 
MI>FLQAT(N) 

ANA>AN-A 

A0-(A1-»A0*ANA>*FAC 

•0><B1-»M)*ANA)*FAC 

ANF-AII*FAC 

A1>X*A0«ANF*A1 

B1>X*MHANF*81 

IF(A1.NE.0.)TMEN 

FA01./A1 

M1*FAC 

IF(ABS((G-GOLO)/G).LT.EPS)GO  TO  1 
GOLO-G 
ENOIF 
11  CONTINUE 

PAUSE  'A  too  largo,  ITMAX  too  SMll' 

1  6AMNCFa£XP(-X«A*AL0G<X>-GLN)*G 

RETURN 
END 


FUNCTION  GANMLNOOO 

REAL*8  COF(6),STP,HALF,ONE.FPF,X.TNP,SER 

DATA  C0F,STP/76. 1800917300, -86.5053203300.24.0140982200, 

*  -1.23173951600, . 1208580030-2, - .5363820-5,2.5066282746500/ 

OATA  HALF,QNE,FPF/0.500, 1.000,5. 500/ 

X-XX-ONE 

TNP»X*FPF 

TMP«(X-»HALF)*I.06(TMP)-TMP 
SER>ONE 
00  11  J«1.6 
X«X-*QNE 

SER>SER«COF(J)/X 
11  CONTINUE 

GAMm.N«TMP>LOG(STP*SER} 

RETURN 

END 


SUBROUTINE  lOOECLSdNP,  OUT,  PLT) 

INTEGER  INP,  OUT,  PLT 
CHARACTER*!  BEEP 
CIIARACTER*80  ITITLE 
CHARACTER*64  HAINP,NAOUT,NAPLT 
LOGICAL  lEXIST 

CONHON  /OEVS/  LUTRN,  LUIN,  LUOUT,  LUPLT 
CONMON  /CURSOR/  BEEP 

COMNON  /LABELS/  ITITLE,  HAINP,  NAOUT,  NAPLT 
OUOTE  « 

LUTRN  X  0 
LUIN  «  1 
LUOUT  X  2 
LUPLT  X  3 

TERNIHAL:  LOGICAL  UNIT  0 

INPUT;  LOGICAL  UNIT  1  (OATA  FILE) 
OUTPUT:  LOGICAL  UNIT  2 
PLOT  FILE:  LOGICAL  UNIT  3 

lEXIST  X. false. 
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ir  (ina  .IK.  0)  THEN 

HRlTEaUTim,'{//,5X,"EMTER  INPUT  FILE  NAHE.")') 

S  REM>(LUTim,'(AM)*>  HAINP 

1NQUIRE(FILE>NAINP,EXIST«IEX1ST) 

IF  (lEXIST)  THEN 

aPEN(LUlN, FILE>NAINP,STATUSa'OLO' } 

URITECLOTRM,'<//,5X." INPUT  FILE  NAME:  ".A6A)')  NAIMP 
ELSE 

URITE(LUTHM.'<5X."*«'  FILE  NAME:  ".AM./.SX.Al. 

•  "NOT  FOUND"  )<}  NAINP.BEEP 
WRITE(LUTRM,‘(/,5X, "ENTER  A  NEU  FILE  NAME.")') 
fiOTO  S 

END  IF 
END  IF 

lEXIST  «  .FALSE. 

IF  (OUT  .M.  0)  THEN 

hrite<lutrm.'(/.5x,"e»,ter  output  file  name.")') 

10  REA0(LUTRM.'(AM)')  NAOUT 

IHOUIRECFILEaNAOUT.EXIST-IEXIST) 

IF( lEXIST)  TNEN 

URITE<LUTRM,'<5X,"***  file  NAME:  ".AM,/,5X,A1, 

•  "ALREADY  EXISTS.  DO  YOU  WISH  TO  OVERURITE  IT?  <Y/N)")') 

•  NAOIT.IEEP 
REA0(LUTRM.'(A1)')  ANS 

IF(ANS  .EO.  'Y'  .OR.  ANS  .EQ.  'y')  THEN 

QPEN(LUaUT,FILEaNAOUT,  IOSTAT>IERR,STATUS-'OLO' ) 

REWIND  LUOUT 
ELSE 

URITE(LUTRM,'(/,5X, "ENTER  A  NEW  FILE  NAME")') 

COTO  10 
END  IF 
ELSE 

OPEN<tU30T,FILE»NAOUT,10$TAT«IERR,STATUS«'NEH') 

END  IF 

«RITE<LUTRM,'<//,5X, "OUTPUT  FILE  NAME:  ",Ad*)')  NAOUT 
URITEaUTRM/</,5X,"00  YOU  WISH  TO  WRITE  A  TITLE  LINE  ON  THE", 

*  "  OUTPUT  FILE?  <Y/N)")') 

REAO(LUTRM.'(A1)')  ANS 

IFCANS  .EQ.  'Y'  .OR.  ANS  .EQ.  'y')  THEM 

WRITE{LOTRM,'</,5X, "ENTER  A  TITLE  LINE.")') 
READ<LUTRM,'(A80)')  ITITLE 
gRITE<LO0UT,'<A1,A80,Al)')  QUOTE.ITITLE.OUOTE 
END  IF 
END  IF 
OFF 

lEXIST  «  .FALSE. 

IF  (PLT  .NE.  0)  THEN 

gRITECLUTRM,'{/,5X, "ENTER  OUTPUT  PLOT  FILE  NAME.")') 

15  READ(LUTRM,'(A64)')  NAPLT 

INQUIRE(FILE>NAPLT,EXIST«IEXIST) 

IFdEXIST)  THEN 

URITE<LUTRM,'<5X,"**»  FILE  NAME;  "  ,A64,/,5X,A1 , 

*  "ALREADY  EXISTS.  00  YOU  WISH  TO  OVERURITE  IT?  (Y/N)")') 

*  NAPLT. BEEP 
REA0(LUTRM,'(A1)')  ANS 

IFtANS  .EQ.  'Y'  .OR.  ANS  .EQ.  'y')  THEN 

OPEN!  LUPLT ,  F I  LE«NAPL" ,  I OSTAT- 1  ERR ,  STATUS* '  OLD ' ) 

REWIND  LUPLT 
ELSE 

URITE<LUTRM,'(/,5X, "ENTER  A  NEW  FILE  NAME")') 

GOTO  15 
END  IF 
ELSE 

0PEN( LUPLT , F I LE-NAPLT , 10STAT» I ERR , STATUS* ' NEW' ) 

EM>  IF 
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gRITE(LUTRM,»(//,5X."PL0T  FILE  «A»(E:  ",A64)' 
END  IF 
RETURN 
END 


SUBROUTINE  INTERP(Y, IHAX1 .0X1 , INAX2.0X2) 
DII«NSiONV(211),  X1(211),  X2(211).  Y2(211) 
DO  10  n  >  I.INAXI 

X1<11)  »  (II  -1)*0X1 
10  CONTINUE 

00  20  12  >  1,IMAX2 

X2(I2)  -  (I2-1>*OX2 
20  CONTINUE 

00  30  12  «  1,IIMX2 

II  «  X2(I2)/0X1  0X1/2. 0 

II  «  II  +1 

IF(I1  .EQ.  1)  II  *  2 
IF(I1  .EQ.  INAX1)  II  *  INAXI  -  1 
U  «  (X2(I2)  -  X1(I1))/0X1 
01  »  Y(I1*1)  -  Y<11-1) 

02  ■  Y<IU1)  -  2.0*Y(I1)  ♦  Y(I1-1) 
Y2(I2)  «  Y(I1)  +  0.5*01*U  ♦  0.5*02*U~2 
30  CONTINUE 

DO  40  12  «  1,1HAX2 
Y(I2)  ■  Y2(I2) 

40  CONTINUE 
RETURN 
ENO 


NAPLT 


457 


458 


oono  ooonn  onoooooooo-*  on 


Appendix  C  -  2 
Tissue  Model  -  Part  2 


PROGRAM  REGPVCUR 


THIS  PROGRAM  DETERMINES  THE  REGIONAL  P-V  CURVES  FOR  THE  REGIONS  LOCATED 
AT  DIFFERENT  VERTICAL  POSITIONS 
DIMENSION  VU,200),VO(10),za(10),OV(10).VGAS(10}.Ppar(a,201), 

*  POSN(20),  PCG(4.200),  RFC(4,200).  Pst(2.4,200),DPGRAVO(10) 
COMMON  A.S.NNAX.NNAX1,CMECKV,DNSTY,IMAX,  IMAX1,  PSTMIN, 

*  PSTMAX,  EBAR,  VE(101),  2(101),  21(101),  20(101),  SMASS(IOI), 

*  P(101),PO(101),OENS(101),E(201),CHECKP,OP,XNASS(101), 

*  VETIS(2O1),VMV(1O1),VLLUNG(3O1),VE0(51),VETV(S1), 

*  CVG3,FI(S1),PMIN,TVE,XA2MAX,2MAX,SA(101),TSMASS(101), 

*  BLNASS(101),H(101),PCAP(101),HRTPOS,H0,PSI, 

*  PART,K,2MAX2,FC(2,201) 

INTEGER  R 

INTEGER  INP,  OUT,  PLT 
INTEGER  CRT,  LUOUT,  LUIN,  LUPLT 
CHARACTER*)  BEEP,  ANS,  QUOTE 
CHARACTER*80  ITITLE 
CHARACTER*64  MAHtP.MOUT.MPLT 
LOGICAL  lEXIST 

COMMON  /OEVS/LUTRN,  LUIN,  LUOUT,  LUPLT 

COMMON  /CURSOR/  BEEP 

COMMON  /LABELS/ITITLE,NAINP,NAOUT,NAPLT 

1  F0RMAT(I2,2F8.2) 

2  F0RMAT(1X,'FC(Jstatus,I)  «,10F8.4) 

3  FORNAT(6F20.3) 

4  FORNAT(10X,I3,4F18.3) 

5  FORMAT(5X,t4,2F10.3) 

6  FORMAT(1X,*PMIN  PSTMAX  OPHYS  IM' ,3F8.3, 13) 

7  FORMATT'IPOS  ■  ',13) 

8  FORMAT)'  VOLUME  INCREMENT  >  ',13) 

101  FORMAT(3X,'K  «  ',I3,3X,'  LUNG  VOL  »  ',F9.2) 

ISTAT-1  IS  A  STATIC  H2  UASHIN-UASHOUT 

ISTAT  -  2  IS  A  STUDY  OF  THE  STATIC  VOLUME  CHANGE  OF  FOUR 

REGIONS  OF  EQUAL  MASS 

ISTAT  «  2 
ISTAT  »  1 

VETIS(I)  IS  READ  IN  AS  THE  GAS  FRACTION  OF  CAPACITY  AND  MUST  BE 
CONVERTED  TO  THE  VOLUME  EXPANSION  OF  THE  TISSUE. BETISCI). 

CRT  >  0 

READ  THE  DATA  FILE  WITH  THE  PARENCHYMAL  INHALATION  AND  EXHALATION 
P-FV  CURVES  THAT  HAVE  BEEN  GENERATED  IN  PROGRAM  TISSFCM.  THESE 
CURVES  INCLUDE  THE  AFFECTS  OF  TERMINAL  BRONCHI  CLOSING  AND  OPENING 
ON  THE  PARENCHYMAL  ELASTIC  CHARACTERISTICS. 


CALL  lODECLSd,  0,  0) 

15  F0RMAT(1X,I4,3F9.Z} 

16  F0RMAT(1X,F7.3,1X,F7.3) 


READ  (LUIN, 15)  IM.Pmin.PstfflSX.DPhys 
URITE(CRT,15)  IM.Pmin.Pstmax.OPhys 
WTE:  Pttmin  IS  DEFINED  IN  SUBROUTINE  VARYMNV 


PAUSE  'PAUSE  DURING  THE  READING  OF  THE  DATA' 
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C  JSTATUS-l  imiMTES  THE  INNAUTION  P-FV  CURVE 

c  jstatus«2  indicates  the  exhalation  p-fv  curve 

C 

Jstatua>1 
DO  18  N>1,IN 

READ(LUIN,16)  Pp«r(J«t«tut.N),FC(Jst«tu«,Nl  I  Inhalation  Ppar-FV  curve 
18  CONTINUE 

C 

JatatuaaE 
00  19  N«1,IN 

READ(LUIN,16)  Ppar<Jetatue,N),FC(Jatatua,H)  lExhalation  Ppar-FV  curve 
19  CONTINUE 

C 

C  DO  40  Jatatus>1,2 

C  NC-0 

C  DO  40  Ne1,IN 

fa 

C  IF(NC.LT.22)  QOTO  40 

C  NCbO 

C  PAUSE'PAUSE  TO  LOOK  AT  Pper  AND  FC  FROM  TISPFV' 

C  40  URITE(CRT.16)  Ppar(Jstatut,N).FC(Jetatus,N) 

C 

C  ANATOMICAL  DEAD  SPACE  DILI 
C 

ADSP  ■  160.00 
P0S2  -  ADSP/2.0 
PDS4  -  AOSP/4.0 
INAX  *  201 
IMAX1  ■  IMAX  •  1 
C 

C  EXPANSION  INFORMATION 
C 

alpha  >  0.20 
lETA  «  0.30 
6AMNA  >  0.50 
C 

C  LUN6  VOLUME.  NASS  AND  GEOMETRY  INFORMATION 
C  VMAX  AND  AMV  REFER  TO  THE  VOLUME  OF  TISSUE  MB  GAS.  RV,  FRC 
C  AND  TLC  REFER  TO  MEASURED  GAS  VOLUMES. 

C 

C  RESIDUAL  VOLUME  IML] 

C 

RV  >  2000.0  INRA 
C  RV  >  1890.00  IJCC 

C  RV  >  1000.00  I  TEST  CASE 

C 

C  FUNCTIONAL  RESIDUAL  CAPACITY  [ML] 


C 

FRC  >  3810.00  INRA 

C  FRC  -  3400.00  IJCC 

C  FRC  *  2500.00  I  TEST  CASE 

C 

C  TOTAL  LUNG  CAPACITY  CMLI 
C 

TLC  «  7600.00  INRA 

C  TLC  *  6400.00  IJCC 

C  TLC  *  4000.00  ITEST  CASE 


C 

C  CORREa  VOLUMES  FOR  ANATOMICAL  DEAD  SPACE 
C 

RV  -  RV  •  ADSP 
'  FRC  «  FRC  •  ADSP 
TLC  *  TLC  -  ADSP 
C 

C  GRAMS  «  NASS  OF  LUNG  «  OVERALL  DENSITY  *  TOTAL  LUNG  CAPACITY; 
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C  THE  DENSITY  AT  TLC  IS  ASSUMED  TO  BE  0.13333g«/cc 

C 

GRANS  ■  TLC*0. 13333 

GET  VOLUMES  AND  UEIGHT  FOR  ONE  LUNG 

GRAMS  >  GRAMS/2.0 
RV  •  RV/2.0 
FRC  >  FRC/2.0 
TLC  ■  TLC/2.0 
VC>TLC-RV 
VMAX  >  TLC  *  GRANS 

FCMIN  >  FC(J*tatUS,1} 

AMV  >  FCNIN*TLC  *  GRANS  lAMunt  Niniaun  VoluM  «  MMllett  air 

vol  *  tiaaiw  vol  outaide  chest. 

DENSITY  «  NASS/VQLUNE 

DNSTY  -  GRAMS/AMV 
URITE(0.3)  ONSTY.AMV.GRANS 

PAUSE  'PAUSE  AFTER  DNSTY, AMV  AND  GRAMS  ARE  PUT  ON  THE  SCREEN' 

TC  >  ANV/1250. 

AO  ■  7.00*TC^ALPHA 
BO  ■  5.25*TC**BETA 
CO  a  10.50*TC**GAMNA 
THETA  a  3.U16*AO*BO/CO**2 

CALCUUTE  THE  TISSUE  FC'P  RELATION  FOR  THE  SUBJECT.  THE  TISSUE 
FCNIN  IS  BASED  ON  THE  RATIO  RV/TIC 

IPOS  a  2 

URITG(CRT,7)  IPOS 

PAUSE'PAUSE  BEFORE  YOU  ENTER  VRYMNV  FOR  THE  FIRST  TINE' 

CALL  VRTMNV(FCMIN,TLC,GRANS,IN,AMV.JStatUS) 

IPOS  a  3 

URITE(CRT,7)  IPOS 

CALCUUTION  OF  ZNAX  FOR  THE  GIVEN  SHAPE  AND  GAS  AND  TISSUE 
VOLUME. 

iS  FORMAT  <2X,'  2NAX0  a  ',F7.2) 

G1  a  1.0 
G2  a  .C0*3.0 
G3  a  0.0 

64  a  3.0*ANV/THETA 

21  a  20.0 

CALL  S0LVEZ(G1,G2,G3,G4,Z1,ZNAX0) 

URITE(CRT,65>  ZNAXO 
PAUSE'PAUSE  AFTER  YOU  WRITE  ZNAXO' 

INFORMATION  THE  BREATH  BEING  ANALYZED 

URITE(CRT,3)  RV,  FRC,  TLC 

VSTART  a  FCiiiin*TLC  I  Vstartalung  volune  inhalation  basins 
VSTQP  a  FCmin*TLC  I  Vstopaluig  volune  exhalation  ends 
TI0VOLaTLC*(1.0'FCMIN)  I  TIOal  VOLune  for  this  breath 

HEART  AND  BLOOD  VOLUME  INFORMATION 

PART  a  10.00 
HRTPOS  a  15.00 


IVital  Capacity  for  a  single  lung 
■Inhalation  status 
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MKT  >  30000.00 
NO  -  0.00000420 
KI  ■  0.000000219 

NUMKR  OF  LUNG  SCCTIONS 

MMX  ■  51 
MMX1  >  MMX  •  1 
DZ  ■  ZIMXQ/MMX1 

OOMIITIQNS  IMEN  THE  LUNG  IS  AT  NINIMUN  VOLUME 

21(1)  -  0.0 
2(1)  ■  0.0 
XNASSd)  >  0.0 
SNASSd)  >  0.0 
VNVd)  >  0.0 
VEd)  -  0. 

JOOUNT>0 
DO  20  N  >  2,MMX 
JCaUHT*JC0UNT«1 
VE(N)  a  1.0 
ZI(N)  a  (H-1)«0Z 

WIIV(N)  a  tNETA  •  (CO  *  (2I(N)**2  •  (ZI(N-1))**2)  - 

•  (ZI(N)**3  -  2I(N-1)**3)/3.0) 

TMMSS(N)  a  DUSTY  *  yNV(N) 

U(N)  a  SAKT*T8MASS(N) 

XIMSS(N)  a  TSNASS(N)  *  XNASS(N*1} 
tMITE(0,21)N,VNV(N),TSNASS(N),SA(N).XMASS(N) 

IF(J0aUNT.LT.20)  GOTO  20 
JCOUNTaO 

MUSE'  PAUSE  TO  LOOK  AT  N,VNV(N),TSNASS(N).SA(N).XMASS(N)' 

20  CONTINUE 

21  FaNNAT(2X.I5,4(2X,P8.3)) 

UKirE(CET.3)  ANV,  X)MS$(MMX} 

PAUSE'PAUSE  AFTEN  VMV  PNINT  OUT' 

NUEIGHT  a  gRANS/4.0  ITiasue  Might  of  a  regio'^  in  gm 
NTLC  a  tlC/4.0  IRogional  gas  voluaa  in  cc 

DO  25  L  a  1,  4 
V(L.1)  >  AMV/4.0 

25  CONTINUE 

C  OETERNINE  POSN(J),  000  VALUES  OF  J  DEFINE  THE  POSITION  OF  THE  CG 
C  ON  THE  MATERIAL  COORDINATE  SYSTEM,  EVEN  VALUES  DEFINE  THE  LOUER 
C  SURFACE  OF  EACH  REGION  ON  THE  MATERIAL  COORDINATE  SYSTEM. 

C 

FRSIZEa.12S 

K-l 

FRMASSaO 

ICOUNTaO 

DO  30  N  a  2,nMAX 
FRMASSOaFRMASS 

FRMASS  a  XNAS$(H)/XNASS(NNAX) 

IF(FRNASS.LT.IC*FRSIZE)  GOTO  26 
POSN(K)aN-U(K*FRSIZE-FRNASSO)/(FRNASS-FRMASSO) 

XaXd 

26  CONTINUE 

C  MITE(CRT.5)  N-l,  XNASS(N),  FMMSS 
ICOUNTalCOUNTi-l 

•  IF(ICQUNT.IM.17)  GOTO  30 
ICOUNTaO 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  NASS  DISTRIBUTION' 

30  CONTINUE 
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C  PMnC'PMJSC  TO  LOOK  AT  THE  NASS  OISTRISUTION' 

P0SM(8)>  NNAX  «  .000001 

K1>  KSNd) 

K2>  P0SM(2) 

K3>  P0Si(3) 

K4s  P0SN(4) 

K5«  P0SN(5) 

K6m  P0SN(6) 

K7-  mN(7) 

K8-  P0SN(8) 

CALOJUTE  THE  OPORAV);  THE  PRESSURE  OIFFEREHCE  BETUEEH  THE  REGIONAL 
CG'«  AT  THE  NININUN  VOLUME 

DPORAVOd)-  (POSN(3)-POSN(1))«OZ^HSTY 
DPGRAV0(2)-  (P0SN<S)-P0SN(3))«02n>NSTY 
DPGRAV0(3)>  (POSM(7)-POSN(5»*OZ^MSTY 

00  31  K>1,8 

31  UR!TE(CRT,5)  K.POSN(K),DPGRAVO(K) 

32  F0RNAT<SX,8I6) 

PAUSE'PAUSE  AFTER  THE  PRINTING  OF  THE  POSN<K),OPGRAVO' 

ITERATION  INFORMATION 

CNECKV  «  2.0 
CHECKP  •  0.01 
OPl  -  0.5 
P2  •  4.00 


CALOUUTE  TNE  NUMBER  Of  VOLUME  INCRENENTS  (OVOL)  FOR  THIS  BREATH. 
THE  LAST  ONE  IS  K  End  Exhalation  (KEEX).  THE  SIZE  OF  DVOL  IS 
ESTIMATED  THEN  ADJUSTED  SLIGHTLY  SO  THAT  IT  FITS  EVENLY  INTO  THE 
TIDAL  VOLUME  <TIOVOL). 


KEINS-1 

Rocalculata  DVO. 

Calculata  K  End  INspiratlon 
KEINS^^I 
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KEIN8N1-TIDVQL/DVDL  I 

DVOL-TIDVa/KEIHSMI  I 

KEINS>aiNSN1-»1  I 

KEINSP1«KEINS«1  I 

KEEX>KEINS«<(VSTART«TIDVOL)-VSTOP)/OVOLICalculate  KEEX 
KEEXN1-KEEX-1 
KEEXM2«EX-2 
KEEXPI-KEEX^I 
FQRNAT(4X,5F10.2) 

URITE(0,35)  yLLUNG(1),VSTART,GRAMS,TIOVOL,OVOL 

PAUSE'PAUSE  AFTER  PRINTING  VLLUNG(1).VSTART.GRANS,TIDVDL,DVOL' 


VLLUNGd)  >  VSTART  *  GRAMS 


DO  1020  K  -  2,KEIHS 
1020  VLLUNG(K)  >  VLLUN6(K*1)  «  DVOL 
DO  1025  K-KEINSP1.KEEX 
1025  VLLUNG(K)  -VLLUNG(K-I)  -DVOL 

DO  1050  L>1.4 
1050  V0(L)>V(L,1) 


MAIN  TINE  00  LOOP 


K-0 
5000  K>K«1 
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INK.6T.aiX)  GOTO  SOO 
WITKOIT.IIOI)  K,VLLUM(K) 

C  MMK'MUK  HraRt  TM  Kth  UM6  VaUNl  CALC  STAXTS' 

iF(K.a.aiinri)  goto  ioo 

CQNVCRT  TM  EXHALATION  P-FV  CUHVE  TO  A  P-VE  (Voluw  Expwwion)  CURVE 

GOTO  2006 

99  OONTIMJE 
jRtatUR^I 
PafinPain-OPtiya 
PafA^PitMF-DPhy 

CALL  VRVMIV(FCNIM,TLC,GRANS,IN«ANV,Jttatija) 

P2-P2-0Ptiya 

100  CONTINUE 
VO.  ■  VLLUN6(K) 

VOLIXP  •  VOl/ANV 
S  >  VOLEXP^nANNA 
HMX  >  INAXO^ 

2Mtt2  >  2NAX  ■»  2.0 

TVE  •  TNETA*VQLEXP~(ALPHA  *  BETA  •  2.0*GAMNA) 

CW  >  00«VatEXP**6ANNA 
CV63  ■  CV8^ 

XA2IIAX  -  TVE*<2.0*CV6*2NAX  -  ZHAX^2) 

FIRST  APPROK  FOR  OENS(N)  AND  Z(N)  •  USE  THE  VALUES  FOR  THE  LUNG 
IN  Ta  UNUEI6NTE0  STATE  •  AS  UEST  STARTED  HIS  OUT. 

IF(K  .EQ.  1)  THEN 
00  110  N  •  2.MMX 

OENS(N)  «  ONSTY/VOLEXP 
Z(N)  •  2Eni(N) 

110  CONTINUE 
END  IF 

DO  120  H  -  2,NNAX 
VEO(N)  -  VEIN) 

20(N)  >  Z(N} 

120  CONTINUE 

VCALO  «  VCALC 

FOR  THE  GIVEN  P2,DENS,Z  AND  GEONETRY  (R**2  *  A*(1  ♦  EBAR)*2/PI*Z, 

FIND  THE  VOUME-VCALC 

PAUa'PAUSE  BEFOa  THE  FIRST  CALL  OPOG' 

CALL  DPDG(P2,  VCALC) 

C  UI1TE(0,3)  P2,  VDL,  VCALC 
F2  >  VOL  -  VCALC 
IF(F2  .LT.  0.0)  THEN 
P3  •  P2  •  DPI 
ELSE 

P3  «  P2  ♦  DPI 
END  IF 
130  FI  -  F2 
PI  ■  P2 
P2  -  P3 

C  PAUSE'PAUSE  BEFORE  THE  SECOND  CALL  OPOG' 

CALL  0P0G(P2, VCALC) 

F2  >  V%  •  VCALC 
AF2  ■  ABS(F2) 

URITE(CRT,51)  P1.P2,F1.F2,VOL,VCALC 
51  F0RNAT(2X,6F9.2) 

IF(AF2  .LT.  CHECKV)  GO  TO  140 
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P5  •  <M*F2  -  P2*F1)/(F2-f1) 

00  TO  130 
140  CQMTtNUE 

ICOUNT-0 

101  FtMmT(2X,13,3F10.2) 

DO  150  N-I.MMX 

C  MIITE(0.101}  N.P(N),VE(N).WIV(N) 

100UNT>IC0UNT  >  1 
IFCI0aUNT.NC.t7)  00  TO  150 

C  PMJK'PMJSC  TO  CHECK  H,P(H),VE(H),VMV(N)  DATA' 

icauNT«o 
150  CONTINUE 
C 

C  CALCULATE  THE  VOLUME  AND  THE  STATIC  RECOIL  PRESSURE  AT  THE  CO  OF  EACH 
C  OF  THE  FOUR  REGIONS  IN  THE  DVHANIC  NQOEL 

C 
C 

C  REGION  1 

V(1,K)  «  0.0 
DO  220  N  -  2.K2 

VCl.K)  -  VCl.K)  ♦  VE(N)*VNV(H) 

220  CONTINUE 

VC1,iO  ■  VCl.K)  ♦CPOSNC2)-K2)*VCCK2+1)*VIIVCK2+1) 

PCGC1.K)-  PCKI)  ♦  CP08NC1)*K1)*CPCKU1)-PCK1» 

C 

C  REGION  2 

VC2,K)  «  CK2«t-POSMC2))«VECK24>1)*VMVCK2+1) 

00  230  N  •  K2*2.K4 

VC2,K)  ■  VC2,K)  ♦  VECN)*VNVCN) 

230  CONTINUE 

VC2,K)  ■  VC2.K)  ♦  CP0SNC4)-K4)*VECK4*1)*VMVCK4>1) 

PCGC2.K)«  PCK3)  ♦  CP0SNC3)-KS)*CPCK3*1)-PCI3)) 

C 

C  REGION  3 

VC3,K)  ■  CK4'*1-P08NC4))*VECK4+1)*VMVCK4*1) 

DO  240  N  >  K4«2,K6 

WC3,K)  ■  VC3,K)  ♦  VCCN)*VNVCN) 

240  CONTINUE 

VC3,K)«VC3,K)^CP0SNC6)-K6)*VECKG»1)*VMVCKG»1) 

PCGC3,K)>  PCKS)  ♦  CP0SMC5)-K5)«CPCK5)-PCK5+1)> 

C 

C  REGION  4 

VC4,K)  •  CK6*1-P0SNC6))*VECK6*1)*VMV<K6*1) 

00  250  N«K»*2,NNAX 

VC4,K)  ■  VC4,K)  ♦  VECN)*VNVCN) 

250  CONTINUE 

PCeC4,K)-  PCK7)  ♦  CP0SNC7)-K7)*CPCK7)-PCK7>1)) 

VOLCHG  -  VCALC  -  VCALO 
C  URITEC0,4) 

255  F0RNATC2X,I3,5F10.3) 

DO  260  L  >  1.4 
V6ASCL)  ■  VCL.K)  •  RUEIGHT 
DVCL)  >  VCL.K)  -VO(L) 

ZOCL)  >  DVCD/VOLCHC 

URITECCRT.255)  L,VCL.K),PCGCL,K).VGASCL).  DV<L).  ZO(L> 

260  CONTINUE 

GASVOL  «  2.0*(VLLUNG(K)  -  GRAMS)  ♦  ADSP 
00  265  L  «  1.4 
VREO  >  2.0*VGA$C1)  ♦  P0S4 
VOCL)>VCL,K) 

265  CONTINUE 
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QOTO  5000 

C . EMO  TO  TINE  LOOP . 

C 

500  CONTINUE 
C 

C  MIMT  PNOGRMI  OUTPUT  TO  A  NANED  DATA  FILE  FOR  RY  THE  DYNmIc 
C  REfilonal  flOM  (Q)  PROGRAN  (PRO  OYNREGO).  THE  DATA  WILL  REPRESENT 
C  TNE  REGIONAL  LUNG  CNARACnPlISTICS  FOR  A  SPECIFIC  8UGJECT. 

C 

C  NAME  THE  OUTPUT  FILE 

C 

CALL  loocasco.i.o) 

C  RECONSTRUCT  RV.FRC.TLC.ANV  AND  GRANS  FOR  THIS  SUBJECT 
C 

RV*«nV»ADSP 

FRC>2*FRC*AI>SP 

TLC*2*TLC«A0SP 

GRANB«2*QRANS 

ANVt^AHV 

C 

C  WRITE  THE  RV,FRCTLC,ANO  AOSP  FOR  THIS  SUBJEa  TO  THE  HANED  FILE 
URITE<LU0UT,2OOS)  RV.FRC.TLC.AOSP 
C 

C  URITE  THE  EXPANSION  COEFFICIENTS.  LUNG  V0LUNE<6A8  AHO  TISSUE)  AT 
C  NININUN  VOLUNE  AND  TNE  TISSUE  HEIGHT  OF  THE  LUNGS. 

C 

URITE<LU0UT.2005)ALPHA,BETA.ANV,GRANS 

C 

C  WRITE  our  THE  PRESSURE  DIFFERENCES  BETWEEN  THE  CG's  OF  THE  FOUR 
C  REGIONS  WHEN  THEY  ARE  AT  NININUN  VOLUNE. 

C 

WRITE<LUaUT,200S)  <0PGRAV0<I},I«1,3) 

C 

C  WRITE  OUT  THE  EXHALATION  P*FV  CURVE;  FIRST  DETERNINE  THE  REGIONAL  Pst- 
C  FV  REUTION  AS  A  FUNCTION  OF  A  CONSTANT  OFC.THIS  REUTIOHSHIP  WILL 
C  IE  INPUT  INTO  PR6  OYNREGQ. 

C 

2000  CONTINUE 
JNAX«50 
JNAXN1-JNAX-1 
FGNAX«1.0 

DFC«(FCNAX-FCNIN}/JNAXN1 

C 

2001  F0RNAT(5X,'  REGION  >',12) 

2002  F0RNAT(SX,2I5,4F10.2) 

2003  FaRNAT(l3.3F10.4) 

2004  FaRNAT(10F8.4) 

2005  F0RNAT(5F10.4) 

2006  F0RNAT(3X.I5,4F10.3) 

C 

INCRQCNT>1 

IF(JttRtUS.Ea.2)  INCRENENT-1 
KJBE6*1 

IF(JstatUS.EQ.2)  KJBEG>KEEX 
KJENOaKEIHS 

IF<JstattM.E0.2)  KJEN0>EE1NS 
C 

C  CONVERT  THE  REGIONAL  GAS  VOLUNES  INTO  REGIONAL  GAS  FRACTIONS  (RFC) 

C 

DO  2050  R«1,4 
WRITE(CRT.2001)  R 
■ IC0UNT>0 

00  2010  KJ>KJSEG,KJENO,INCRENENT 
ICOUNTalCOUNT^I 

RFC(R , K J )>( V(R , K J ) • RWE I GHT ) /RTLC 


466 


Progrwn  REGPVCUR.FOR 


WlTe(CI(T,2006)  KJ,  VO.KJ),  l(FC(R,KJ),  PCG(R.KJ).  RTLC 
IFdCOUMT.LT.aO)  GOTO  2010 

RAUSC'PAUSE  TO  LOOK  AT  KJ,  V(R.KJ),  RFC(R,KJ),  PCG(R,KJ),  RTLC' 
IC0UNT>0 
2010  CONTINUE 

PAUSE'PAUSE  TO  LOOK  AT  KJ,  V(R,KJ),  RFC(R,KJ),  PCG(R,KJ),  RTLC' 
C 

C  OETERNINE  THE  Ptt  AS  A  FUNCTION  OF  RFC  IN  INCREMENTS  OF  OFC.J  IS 
C  THE  VARIABU  FOR  THE  NEW  Pst-FC  DATA  FOR  PRG  DTNREGO.  KJ  IS  THE 
C  VARIAILE  FOR  THE  REGIONAL  Pcfl-RFC  DATA  THAT  REPRESENTS  THE 
C  VOLUME  INCREMENTS  DURING  THE  IHHAUTION  AND  EXHAUTION.  THE 
C  CUR^  INTERPOUTION  STARTS  AT  FCMIN  (J«1)Ain  INCREASES  IN  DFC 
C  INCRBCHTS,  SO  THE  INITIAL  VALUE  FOR  KJ,  KBEG.DEPENDS  ON 
C  WHETHER  IT  IS  FOR  INHALATION  OR  EXHAUTION. 

C 

J»1 

KJ<JBE6 

ICOUNTaO 

2020  ICOUNT-ICQUNT-'^I 

FCJaFCNIIH<J*1)*0FC 
IF(J.EQ.I)  GOTO  2035 
2030  IF<RFC(R.KJ).6T.FCJ)  GOTO  2040 
IFCKJ.EG.KJENO)  GOTO  2040 
KJXU^INCRENENT 
GOTO  2030 
2035  CONTINUE 
C 

C  CALOUUTE  THE  PST  FOR  THE  FIRST  POINT  ON  TIC  PST  CURVE  <J>1) 

C 

KJIaKJ 

KJ2aKJ-»INCREMENT 

2037  IF(RFC(R,KJ2).GT.RFC<R,KJ1)>  GOTO  2038 
KJ1«KJ1«INCREMENT 
KJ2««J2»IMCREMENT 

GOTO  2037 

2038  Ua<FCJ*RFC(R.KJ1))/(RFC(R,KJ2)-RFC(R.KJ1)) 

PST( J«t«tUS,R . J )>PC8(R,KJ1 )«U*(PC8(R,KJ2)-PCG(R,KJ1 ) ) 
URITE(CRT,2002>  J,KJ,FCJ,Pst(J«tatut,R,J),PCG(R,KJ}.RFC(R,KJ) 
KJ<«J2 
JaJ+1 
GOTO  2020 

2040  Ua<FCJ-RFC(R,KJ'1})/(RFC(R,KJ)-RFC(R,KJ-1)) 

PST<JstatU>.R,J)aPC9(R,KJ-1)4U*(PCfl<R,KJ)-PC9(R,KJ-1)) 
IMITE(CRT,2002}  J,KJ,FCJ.Pat(Jatatua,R,J),PCG(R,KJ),RFC(R,KJ) 
IF(I00UNT.LT.22)  GOTO  2045 

PAUSE'PAUSE  TO  SEE  J,KJ,FCJ,Pat(Jatatua,R, J),PCG<R,KJ>,RFC(R,KJ) 
1C0UNT"0 

2045  IF(J.EO.JNAX)OOTO  2048 
JaJ^I 
GOTO  2020 
2048  CONTINUE 

PAUSE'PAUSE  TO  SEE  J,KJ,FCJ,Pst(Jstatus,R, J),PCG(R,KJ>,RFC(R,KJ) 
2050  CONTINUE 

IF(JSTATUS.EQ.I)  GOTO  99 
C 

C  WRITE  PST  DATA  TO  A  NAMED  FILE  FOR  USE  IN  PROGRAM  DTNREGO 
C 

URITEaU0UT,2003)  JMAX, FCMIN, FCMAX 
DO  2100  R»1,4 
DO  2100  JatatuaBl,2 

2100  URITE(LU0UT,2004)(Pst(J8tatua,R,J),  Ja1,JNAX> 

URITE(LU0UT,2003)  IN,Pm<n,P8tmax,0Phys 

URITE(LU0UT,2004)(FC(1,N),N«1,IH)  lOriginal  data  from  TISPV 
WRITEaU0UT,2004}(FC(2,N},N>1,IN>  lOriginal  data  from  TISPV 
STOP 
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nn 

c . 

9UMQUTINE  0n>O<P2.VCALC) 

C  Subroutliw  calculatM  tha  tiasut  praasuraa  at  tha  top  of  each  aaction 
c  for  tha  flfvan  danetty  uaing  tha  hydroatatfc  praeaura  aquation 
COMNOa  A,I,IMM,NNN(1,CHECXV,DIISTV,1WU(,  IMAXl.  PSTMIN, 

*  MTMM,  eiAR.  VK(IOI).  Z(101),  Zl(101),  Z0(101).  SMASS(IOI), 

*  P<101),N(101>,DENS(101},E(201},CHECKP,OP.XNASS(101), 

*  VETIS(201).VNV(101).VLLUN6(301),VE0<S1).VETV(51), 

*  CVB3,FI(51>,PN1N,TVE.]MZNM(,ZMU(.SA(101),TSMASS<101). 

*  lUMndOD.HdOD.PCAPdOD.HRTPQS.HO.PSI. 

*  PMT.K,ZIMX2.FC(2.201} 

10  FaMMT(3X,3F12.3> 

C  PAUK'PAMC  KFORE  THE  FIKST  P(H)  CALC  IH  OPOG' 

Pd>  -  P2 
DO  20  H  ■  2.HNAX 

P(H)  «  P(H-1)  -  DEHS(H)*(Z(N)  •  Z(N-1)) 

C  MITE(O.IO)  P(N),2(N).DENS(N) 

20  CONTINUE 

C  PAUSC'PAUSE  BEFORE  THE  FIRST  CALL  CLCVL  IN  DPOC' 

CALL  CLCVL(VCALC) 

25  DO  30  N  -  2.NNAX 
PO(N>  -  P(N) 

30  CONTINUE 

C  PAUSE'PAUSE  BEFORE  THE  SECOND  P(N)  CALC  IN  OPDG' 

DO  40  N  ■  2,NNAX 

P(N)  •  P(N*1)  •  0ENB(N)*(Z(N)  <  Z(N*1» 

C  URITE(0,10)  P(N)«Z(N),0ENS(H) 

40  CONTINUE 

C  PAUSE'PAUSE  BEFORE  THE  SECOND  CALL  CLCVL' 

CALL  aCVL(VCALC) 

G  >  POCNNAX)  •  P(NNAX) 

AG  a  ABS(G) 

IF<A6  .6T.  CHEOCP)  GO  TO  25 

RETURN 

END 

C . 

SUBROUTINE  aCVL(VCALC) 

COMNM  A.B,NNAX,NNAX1,CNEaCV,DNSTY.INAX,  INAX1,  PSTHIN. 

*  PSTNAX,  EBAR,  VEdOl),  2(101),  21(101),  ZOdOl),  SNASS(IOI), 

*  P(101),PQ(101),OENS(101),E(201),CHECICP,OP.XNASS(101), 

*  VETIS(201),VNV(101).VLLUNG(301),VEO(51).VETV(51). 

*  CV63.FI(51).PNIN,TVE,XAZNAX,ZNAX.SA(101),TSHASS(101). 

*  BLNASS(101),H(101),PCAP(101),HRTPOS,H0.PSI, 

*  PART,K,ZMAX2,FC(2,201) 

VCALC  a  0.0 
DO  301  N  a  2,NMAX 

II  a  (P(N)  -  PSTHIN)/DP  *  1 
IFdl  .LT.  2)  GO  TO  100 
IFdl.  GT.  IHAX1)  GO  TO  200 
U  a  P(N)  •  (PSTNIN  ♦  OPa(II-l)) 

VE(N)  a  VETIS(II-I)  ♦  U*(VETIS(II  ♦  1)  -  VETIS(II-1))/(2.*0P) 

I  ♦  uaa2a(vETIS(II-M)  -  2.0*VETIS(II)  ♦  VETIS(II-1»/0P**2 

GO  TO  300 

100  U  a  P(N)  •  PSTNIN 

VE(N)  a  VETISd)  ♦  U*(-1.5*VETIS(1)  ♦  2.0*VETIS(2)  - 
A  0.5«VETIS(3))/DP 

IF(P(N)  .LE.  PSTNIN)  VE(N)  a  VETISd) 

GO  TO  300 

200  U  a  P(N)  -  (PSTNAX  -DP)  I  P  at  INAXI  aPSTNAX-DP 

■  VE(N)  a  VETIS(INAXI)  *  U*(VETIS(INAX)  -  VETIS(IMAX1))/DP 

300  IF(VE(N)  .LT.  1.00)  VE(H)  a  i.OO 
VCALC  a  VCALC  *  VE(N)*VNV(N) 

301  CONTINUE 
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Program  RE6PVCUR.F0R 


CALCUUTE  THE  BLOOD  VOLUME,  BASED  ON  THE  OLD  2  POSITION, 

AND  THE  DENSITY,  BASED  ON  THE  BLOOD  MASS  AND  THE  TISSUE  EXPANSION 


>9  F0BMAT<2X,IS,6(1X,F8.2» 

JC0UNT«0 

SIMbO 

VE<1)  •  VE<2) 

DO  310  H  •  2,NNAX 
JOOUNTbJCOUHT'^I 
PALV  >  0.0 

IF(P(N>  .LT.  0.0)  PALV  >  -P(H) 

PCAP(N)  -  PART  *  ((Z(H)  *  Z(H-1))/2.0  -  HRTPOS) 

PTM  -  PCAP(N)  -  PALV 
H<N)  •  dO  *  PSI*PTN 
IFLPTM  .LT.  0.0)  H(N)  -  0.0 
SMASS(N)  «  TSNASS(H)  *  BLNASS(N) 

OEHS(N)  •  SNASS(N)/(VMV(N)*(VE(N)  VE(H-1))/2.0  «  BLNASS(N)) 
SUN-SUN«VE(N)*VNV(H) 

WITE<0,99)  H,OENS(N),SNASS(N),VNV(N),VE<N),TSMASS(N),SUN 
!F(JC0UNT.LT.20)  60T0  310 

PAUSE'PAUSE  TO  LOOK  AT  N,OENS,SNASS,VNV,VE,TSNASS,CALCVOL' 
JCOUNTaO 
310  CONTINUE 


DO  400  N  ■  2,HMAX 

CALCULATE  THE  NEW  2  POSITIONS 

IF  (Z(N-1)  .GT.  ZNAX2)  GO  TO  3S0 
61  >  1.0 
62  «  •CVG3 
GS  «  0.0 
Z1  >  Z0(N) 

315  64  *  CVG3*2(H*1)*n  -  2(H-1)**3  ♦  3.0*SMASS(N)/(DENS(H)*TVE) 

320  CALL  S0LVEZ<61,G2,G3,G4,Z1,2(H)) 

IF(Z(N)  .6T.  0.0)  60  TO  400 
Z1  •  Z1  ♦  1.0 
GO  TO  320 

350  Z(N)  B  Z(N-1)  >  SMASS(N)/(OENS(N)*XAZMAX) 

400  CONTINUE 

DO  500  N  -  2,NNAX 
ZO(N)  B  Z(N) 

500  CONTINUE 
RETURN 
END 

C . 

SUBROUTINE  VRTMNV(FCMIN,TLC,GRAMS, IM,AMV, JSTATUS) 

COMMON  A,B,NMAX,NMAX1,CHECXV,DNSTY,IMAX,  IMAXl,  PSTNIN, 

•  PSTMAX,  EBAR,  VE(101),  Z(101),  ZI(IOI),  Z0<101),  SMAS$(101>, 

•  P(101),PO(101),DENS(101),E<201),CHECICP,OP,XMASS(101), 

•  VETIS(201),VMV<101),VLLUN6(301),VE0(51),VETV<51), 

•  CVC3,FI(51),PMIN,TVE,XAZMAX,ZMAX,SA(101),TSNASS(101}, 

•  BLNASS(101),H(101),PCAP(101),HRTPOS,H0,PSI, 

•  PART,K,ZNAX2,FC(2,201) 

INTEGER  CRT,  OFILE 

COMMON  /DEVS/  CRT,  LUIN,  OFILE,  LUPLT 
C 

C  DETERMINE  THE  PRESSURE  AT  WHICH  THE  VOLUFS  STARTS  TO  CHANGE  - 
C  PSTNIN;  AND  CHANGE  THE  FC  DATA  TO  VOLUME  EXPANSION  (VET IS)  DATA 
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Program  REGPVCUR.FOR 


3  FaRMAT(SX,l5,4F12.4) 

A  FaiMAT(10X,l3,4F12.3} 

DPC  >  (PSTMAX  -  PN1N)/(IN-1) 

1  ■  1 

5  I  ■  I+l 

IF(FC(J«t«tlM.I)  .6T.  FC(Jstatua,1))  GO  TO  6 
00  TO  S 

6  PSTMIN  •  PMIN  *  (I-2)*0PC 
MtITE(0,3)IN,PSTMIK.PMlH.PSTMAX.DI>C 

PAUSE'PMISE  AFTER  PRINTING  OF  IN,PSTMIN,PMIN.PSTNAX,OPC' 

ILF  -  1-2 
IMF  •  IN  •  ILF 
DO  7  I  ■  I.INF 

IXF  ■  I  4^  ILF 

FC(Jst«tus,I)  ■  FC(JAt«tU>,IXF} 

7  CONTINUE 

DP  •  (PSTNAX  •  PSTMIN)/INAX1 

FVCS  >  FC(J«tatl»,IN)  •  FCMIN 

FVCO  "  FCCJStKUi.IN)  -  FC(Jatatut.l) 

SCALE  «  FVCS/FVCO 
E(1)  >  FCMIN 
DO  8  1  •  2,fNF 

E(I>  -  E(I-1)  4  SCALE*(FC(Jatatua.I)  •  FC(Jstatua,I-1)) 

S  CONTINUE 

00  9  I  •  I.INF 

FCCJatatua.I)  >  E(I) 

9  CONTINUE 

DO  10  I  >  I.IMF 

VETlSd)  a  (FC(Jatatua,l)*TLC  4  GRANS)/AMV 

10  CONTINUE 
JOOUNTaO 

DO  15  I  a  I.INF 
JC0UNTaJ0aUNT4l 
PR  a  PSTMIN  4  (I-1)«0PC 
OENSCaQRANS/(FC( Jatatua, I )*TLC4GRAMS) 

URITE(0.4)  1.  PR.  VETIS(I),  OENSC.  FC( Jatatua, I) 

if(jcount.lt.20)  go  to  15 

PAUSE'PAUSE  TO  LOOK  AT  I,  PR,  VETIS(I),  OENSC,  FCCJstatus, I )' 
JCOUNTaO 
15  CONTINUE 

PAUSE  'PAUSE  TO  LOOK  AT  I,  PR,  VETISd),  OENSC.  FC(Jstatus,I}' 

CALL  INTERP(VETIS.IMF,OPC.INAX,DP) 

JCOUNTaO 
DO  20  I  a  1.INAX 
JC0UNTaJC0UNT4l 
PR  a  PSTMIN  4  (I-1)*0P 
DENSCaGRANS/(FC( Jatatua, I }*TLC4GRAMS) 

URITE(0,4)  I,  PR,  VETISd),  OENSC,  FC( Jatatua, I) 

I F( JCOUNT.lt. 20}  GO  TO  20 

PAUSE'PAUSE  TO  LOOK  AT  I,  PR,  VETIS< Jatatua, I),  OENSC,  FCCJatatua,!)' 
JCOUNTaO 
20  CONTINUE 
RETURN 
END 


SUBROUTINE  INTERP(Y,IMAX1,DX1,IMAX2.DX2) 
0INENSI0Ny(211),  X1(211),  X2(211),  Y2(211) 
DO  10  II  a  I.INAXI 

XKII)  a  <11  .1>*0X1 
10  CONTINUE 

00  20  12  a  1,INAX2 

X2d2)  a  d2-1)*OX2 
20  CONTINUE 

DO  30  12  a  1,IMAX2 
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Program  REGPVCUR.FOR 


II  >  X2(I2)/DX1  ♦  0X1/2. 0 
II  »  II  +1 

IF(I1  .EQ.  1)  II  -  2 
IF(I1  .EQ.  IMAX1)  II  >  INAXI  •  1 
U  >  (X2(I2)  -  X1(I1))/DX1 
01  »  r<IU1)  -  Y(IM) 

02  »  Y<IU1)  ■  2.0*Y(I1)  ♦  Y<11-1) 
Y2(I2)  ■  Y(I1)  ♦  0.5*01*U  ♦  0.5*02*U**2 
30  CONTINUE 

00  40  12  >  1.1NAX2 
Y(12)  «  Y2(I2) 

40  CONTINUE 
RETURN 
END 


SUBROUTINE  SOLVEZ(A,B,C,0,20.Z2) 

Z2  -  ZO 

10  F  »  A*Z2**3  ♦  B*Z2**2  ♦  C*Z2  ♦  0 
AF  >  ABS(F) 

IF<AF  .GE.  O.OS)  THEN 
FP  »  2.0*A*Z2*'*2  ♦  2.0*B*Z2  ♦  C 
Z2  >  Z2  -  F/FP 
GO  TO  10 
END  IF 
RETURN 
END 
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Appendix  C  -  3 
Ventilation  Model 


PROGRAM  SBBOLUSD 


OlNENSIOi  OV<7),CMLUSC30>.VIIAX(10).C80Lr*9(10) 

CQMNON  FLOU(601).VOLIH(601),F(15).RTLC(15).UL(2S),M>(2S), 

♦  P1(201),V<7),AUL<7, 18), H<r),Z<10), 20(10), RCV(7),0Vdt,C0eFA, 

♦  AM><7,18),O<7),P«t(2,7,151),p™(7,30),0EMSITt.VISCSTY.VlSIC, 

♦  P(15),DPR(15),RES(15),OPRL(15),OHAX<25).VO(15),JCCIUMT.U<7.20), 

♦  VOLO<15),r,I«MFC,«IUNITS,OFC,Fam.APCPL<25),»l6EM,DD.XL)1AX(24>, 

4^  PERICO,OT,TMAX,FaMX,DELVOL,FOMAX(201),XKM1(7),XK(7,25), 

♦  0P6<7,ie).RESC0M<7,18),RESVlS(7.18),JlllSlCM,JEXSIG»l,FCFRC,TLC. 

♦  0Ppt»,I»«FCm,JCYCLE,PmiIM,PTI(NAX,VE.VmilLW«G,UEICMT,DPGRAV(7), 

♦  FVt(201),liWxF(yi,J«,TXAR(7,30),POIS<7,30),F0MAX0,SL0PE0, 

♦  JSTADYM,  JQSmiC,OP6RAVO<7),OFCS,OFC2,AHOUIIT{7),CI ,  J«*xPTM, 

♦  M0EI«)P,IWEM0P1,OIC.QG<5),RyElGHT<10),RVE(10),RMmVOL(10),OR(10), 

♦  OPV<7,30),OPC(7,30) 


C 

C  COMNON  STATEMENTS  FOR  lOOECLS 
C 

INTEGER  A1,  A2 

INTEGER  CRT,  LUOUT,  LUIN,  LUPLT 

CHARACTER*)  SEEP 

CNARAaER*80  ITITLE 

CNARACTER*64  NAINP,NAQUT,NAPLT 

OONNON  /DEVS/LUTRN,  LUIN,  LUOUT.  LUPLT 

COMMON  /CURSOR/  BEEP 

COMMON  /LABELS/ITITLE.HAINP.NAOUT.NAPLT 


1  FORMAT(4F10.3) 

2  FaRNAT(5F10.4,l10) 

3  FORMAT(13F6.3) 

4  FaRMAT(l3,2F10.4) 

5  FaRNAT(13F6.2) 

6  FORMAT<10E13.3) 

7  F0RMAT(4IS,F10.2) 

9  FORMAT</I10,3F15.3) 

10  FaRMAT(4F25.5) 

14  F0RMAT<2X,I10,7F14.5) 

15  F0RMAT(2110,8F12.4) 

18  F0RMAT(2E15.3) 

20  FORMAT!'  J',  9X,'2(J)',  9X,'  0{J)  9X,'  V(J)  9X,'  H 

♦«,'  PVC  9X,'  FTV  9X.'  P<J)  ',8X,'0PRL(J)',7X,'RCF(J)') 

21  F0RMAT(I3,F15.3,2F15.2.5F15.4,F13.4) 

23  FORNAT(IHI) 

25  FORMAT!/) 

26  FORMAT! 10F8.1) 

28  F0RMAT!10F8.4) 

29  F0RMAT!1X,9F8.4} 

30  F0RNAT!1X,15,2F10.2} 

31  F0RMAT!lX,I4,F8.1,4F8.2.4Fe.l) 

32  F0RMAT!2X,15,5F9.2) 

33  FORMAT! 15, F6.1) 

34  FORMAT!5F11.5) 

35  FORMAT! 10F8.1) 

CRT>0 


DEFINE  THE  TYPE  OF  BREATH  THAT  WILL  BE  ANALYZED 
JSTADYN  INHALATION  EXHALATION 

1  DYNAMIC  DYNAMIC 

2  STATIC  STATIC 

3  DYNAMIC  STATIC 

4  STATIC  DYNAMIC 
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Program  SBBOLUSD.FOR 


JSTADVN-1 

OVdtxZO  IVoltJM  IncrMint  per  OT  tie*  etep 

C 

C  READ  IN  THE  LUNG  VOLUMES  FOR  THIS  SUBJECT  FROM  THE  DATA  FILE  CREATED 
C  IN  REGPFCUR.  ALPHA  AND  BETA  ARE  EXPANSION  COEFFICIENTS  AND 
C  VNINLUNG  IS  THE  NIHINUN  VOLUME  OF  THE  LUNGS  (GAS  AM)  PARECHYMA), 

C  AND  HEIGHT  IS  THE  TOTAL  MASS  OF  (HE  LUNGS. 

C 

CALL  IQDECLSd.O.O) 

REAO(LUIN,2)  RV.FRC.TLC.DEAOSP 
REA0(LUIN,2)  ALPHA. BETA, HEIGHT 
l«AD(LUIH.2)  (0PGRAV0(I),Ia4,6) 

C 

C  READ  IN  THE  LUNG  FUNCTIONAL  DATA. IT  IS  ASSUMED  THAT  THE  LUNG 
C  TISSUE  HAS  NO  HYSTERESIS  ANO  ALL  REGIONS  HAVE  THE  SAME  TISSUE 
C  CHARACTERISTICS.  THE  REGIONALP  P-V  CURVES  HAVE  BEEN  CALCULATED 
C  OUTSIDE  THIS  PROGRAM  UITH  THESE  ASSUMPTIONS. 

C 

REAO(LUIN,A)  IMXFC.FCMIN.FCMAX 

DO  40  J>«,7 

DO  40  Jetatue  ■  1,2 

40  READ(LUIN,28)  (Pst(jstatus. J,I).I«1,IIMU(FC) 


0FC>(FCNAX-  FCNIN)/(  laucFC- 1 ) 

DFC2*2.0n>FC 
DFCS«0FC^2 
SL0PE>5.0/DFC 
DO  41  Ja4.7 
00  41  Jatatuf«1,2 

C  ADO  TUO  LINEAR  POINTS  TO  THE  BEGIHNING  OF  THE  CURVE 
00  39  I«ImxFC.1,-1 

39  Pet(J«tetue,J,I>2)>Pst(J«tatus,J,I) 

PetCJetetua, J,2)>Pat( Jetatue, j,3)-slope*dfc 
Pet(JetetUB,J,1)>Pet(Jetatue.J,3)*2.0*SL0PE*0FC 
C  ADO  THO  LINEAR  POINTS  ONTO  THE  END  OF  THE  CURVE 

Pet(  Jetatue,  J,  lMxFC'^2)>Pet(  Jetatue,  J ,  ImaxFC'M  )«’SL0PE*DFC 
Pet(  Jetatue,  J ,  IaaxFC'*'3)>Pet(  Jetatue,  J ,  InaxFC't'l  >-^2*SL0PE*DFC 
41  Pet(  Jetatue ,  J ,  IiaaxFCH  )3i>st(  Jetatue ,  J ,  IinaxFC'''1  )'»3*SL0PE*DFC 

IiiaxFC«IaaxFC44 

liiaxFCM1>lMxFC-1 

ImxFCPIsImxFC*^! 

FCNIN«FCMIN-2.0*OFC 

FGMAX>FCMAX>2.0^FC 


READ  IN  THE  EXHALATION  PARENCHYMAL  P-FV  RELATIM 
FOR  CALCULATING  AIRUAY  OIAM 

READ(LUIN,4)  Jaax.PTMMIN.PTMMAX 
REA0(LUIH.28)(FVt(J),Js1,Jinax) 

ADD  HYSTERESIS  TO  MAKE  P-FV  CURVE  AN  INHALATION  CURVE 
HYSTERESIS  IN  A  VC  BREATH  IS  4.0cffl  H20 

DPHVS-4.0 

PTMNIN*PTNN1N'H)PNYS 

PTMMAX>PTMHAX'H)PHYS 

URITE(CRT,4)  J«ex,PTMMIN,PTMMAX 
URITE(CRT,28)(FVt(J).J-1,Jinax) 

PAUSE'PAUSE  TO  LOOK  AT  IMFVA.PTNNIN.PTHMAX  AND  FVtd >, 1-1, INFVA' 
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Program  SB80LUSD.F0R 


jMXN1aJMX-1 

0EM>SPACE>160cc  TOTAL  ANATOMICAL  OEADSPACE 

RDS>2Scc  ANATOMICAL  OEADSPACE  WITHIN  A  REGION  THAT  REPRESENTS 

A  QUARTER  OF  THE  TOTAL  LUNG  NASS 

UAM>S*60cc  anatomical  OEADSPACE  FOR  THE  UPPER  AIRWAYS 

(MOUTH , THROAT , TRACHEA } 

OEAOSPACE«160.0 

RDSbES.O 

UAUDS>60.0 

TLCT-TLC 

FRCT-FRC 

TLCbTLC'OEAOSP 

FRCbFRC'DEADSP 

RV>RV-OEAOSP 

FCFRC-FRC/TLC 

VMINLUNG>FCMIH*TLC-»WEIGHT 

OPEN  OUTPUT  FILE 

CALL  IOOECLS(0,1,0) 

INPUT  DATA  FOR  WEIBEL'S  LUNG  NODEL  A  FRON  WEIBEL.OAT 
NISbS 

OPEN  INPUT  FILE  'WEIBEL.OAT' 

OPEN(NI5,FILE>'WEIBEL.OAT') 

NGENb23  INunSMr  of  afruay  gcnarationa 

REAO(NI5,1)  VON  ITotal  gaa  voluaa 

REA0(NI5,3)  (WL(N).N>1.23)  lAIniay  langtha  in  am 
READ(NI5,3>  (UD(N),N«1,23)  lAirway  diaMtera  in  cm 
WTROIAM  >  1.8  ITrachaa  divaatar  in  cm 

READ  IN  THE  BOLUS  CONCENTRATION  AT  THE  END  OF  THE  tmCHEA 
THIS  PROFILE  WAS  CALCULATED  OUTSIDE  THIS  PROGRAM 

NIAbA 

OPEN(NIA,FILEb'CSOLUS.DAT' ) 

READ(NIA,33)  JmxB.OVbolut 
REAO(NIA,3A)  (CBOLUSfJBI.JB-I.JmxB) 
jawBP1«JaaxB>1 
HRITE(CRT,33)  JaaxB.OVbolus 
WRITE(CRT,3A)  (CBOLUS(JB), JB>1,JnaxB) 

PAUSE'LOOK  AT  IHPUT  DATA' 


SUBSCRIBTS  THAT  OEFIHE  THE  DIFFERENT  AREAS  OF  THE  LUNG  MODEL 
SUBSCRIBT  1  •  ENTIRE  LUNG 

SUESCRIBT  2  -  UNIT  COMPOSED  OF  UPPER  TWO  REGIONS  1  and  2 

SUBSCRIBT  3  •  UNIT  COMPOSED  OF  LOWER  TWO  REGIONS  3  and  A 

SUBSCRIBT  A  -  REGION  1 

SUBSCRIBT  5  -  REGION  2 

SUBSCRIBT  6  -  REGION  3 

SUBSCRIBT  7  •  REGION  A 

F(1)«1.0  (F(I)  IS  THE  LUNG  NASS  OF  EACH  AREA 

F<2)«.5 
F<3)«.5 
F(A)«.25 
F(5)».25 
F(6)>.2S 
F(7)«.25 
C 
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C  IMtTIALIZE  VARIMLES 
C 

DO  36  J>1,7 
AM0UNT(J)-0.0 

RTLC(J)bF(J)*TLC  (Regional  TLC,  does  not  include  the  upper 

RICI6NT(J)*F(J)*UEIGHT 
RNIIIVQL(J}M(J)*VMINLIMG 
RCV(J>«.5 
36  DML(J)>.1 

DPF6-0.0 

FOG»1.0 

IS0LUS>1 

C>0.0 

C 

C  CHECK  INPUT  DATA 

C 

C  URITE(CRT,TO)  FRC.TLC 

C  PAUSE'PAUSE  TO  LOOK  AT  FRC.TLC  ' 

C  W1TE<CRT,28)  (  F(J).J«1,7) 

C  PAUSE'PAUSE  TO  LOOK  AT  F(J)  ' 

C  UR1TE(CRT.26>  (  RTLC(J).J>1.7) 

C  PAUSE'PAUSE  TO  LOOK  AT  RTLC(J)  ' 

C  UIITE(CRT,3)  (UL(N).N«1,23) 

C  PAUSE'PAUSE  TO  LOOK  AT  UL' 

C  UR1TE(CRT.3)  (iO(N).N>1.23) 

C  PAUSE'PAUSE  TO  LOOK  AT  UD' 

DO  44  J>4.7 
DO  44  Jstatues1,2 

URITE(CRT,29)  (Pet( Jstatus, J. I ), !>1 . ImaxFC) 

PAUSE'PAUSE  TO  LOOK  AT  PST  ' 

44  CONTINUE 

C  MIITE(CRT,29)  (FVt(J>.J>1.4aax) 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  FVA' 

C 

C  READ  IN  THE  EXPERIMENTAL  CONDITIONS 

DENSITY  «0.001121  IgMS/cm^S 

VISCSTY  >0.0001914  l0B^(sec*cm) 

VISK*VISCSTY/OENSITY  (Kinematic  VIScosit/  (an**2/sec) 

61*1/900.2  ldyne8/a»**2=(1/980.2>ciiiH20 

00aGI*0ENSITY/2 

DK*OENSITY*0.85  (0.85  experimental  constant  for  conv  ecc 

EXC*1.8S  (1.85  experiaiental  constant  for  vis  losses 

C0EFA-EXC*5.659^ISCSTY  (COEFficient  for  Vis  Losses 

NGENDP*16  (#  of  gen  used  in  DP  calc 

NGEM>P1>NGEN0P4’1 
C 

C  URITE(CXT,6}  VISCSTY.DENSITY.VISK 

C  PAUSE'PAUSE  TO  LOOK  AT  VISCSTY.  DENSITY.  VISK' 

C 

CALL  FLOUUfKMAX.KEINS.VSTART) 

V(1}*VSTART-0EADSP  (gas  Volume  of  area  I  at  the  start 
C 

C  USE  CONSTANT  VOLUME  INCREMENTS  OF  OVdt  SIZE  IF  THIS  IS  A  STATIC  BREATH 
C 

IF(JSTADYN.NE.2)  GOTO  49 

VOLIN(1)*0.0 

DO  47  K>2.KEINS 

47  VOLIN(K)*VOLIN<K-1)«OVdt 
KEIHSPI-KEIHS-^I 

DO  48  K>KEINSP1.KMAX'»1 

48  VDLIN(K)>VOLIN(K-1)-DVdt 

49  CONTINUE 
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Program  SB80LUSD.F0R 


URlTE(CtT,2)  TIDVOL.  DT,  TNAX 
PMISE'PMiSE  TO  LOOK  AT  TIOVOL,  V(1),  OT,  TNAX  ' 

CALCULATE  THE  MAXIHUN  LENGTH  AND  DIANETER  OF  EACH  GENERATION 

SCALE-<TLCT/VQM)**(1./3.)  ITh*  lirwar  scaling  of  VON  to  TLCT 

TRCONAX-WTROIAir*SCALE  INaxiaui  trachaa  diaawtar 

00  so  N-1.NGEH 

XLNAX(N)>SCALE*UL(H)  INaxiM  airway  lengths 

SO  DNAX(N)«SCALE*U>(H)  INaxiM  airway  disMters 

UR1TE(CRT.3>  (XLNAX(N),N>1,NGEN) 

PAUSE'PAUSE  TO  LOOK  AT  (XLMAX(N),H>1 .HGEH)' 

URITE(CRT,3)  <0NAX(H),N«1.NGEN) 

PAUSE'PAUSE  TO  LOOK  AT  (0NAX(N).H«1 .HGEH)' 

CALCUUTION  OF  ONEGA  •  XKM-2.0  AT  P-5CNH20 
t>1 

SA  IF(Pst(Jstatua,6.n.GE.S.O)  GO  TO  S6 
1»I+1 
GO  TO  SA 

S6  0NEGA>(Pst(JstatUB,6.1'»1)-Pst(Jstatja,6,l-1))/(2.*DFC) 
UR1TE(CRT,1>  ONEGA  INOTE  ONEGA-IG.O  as  H20  CHECKI I 

PAUSE'PAUSE  TO  LOOK  AT  ONEGA' 

XKI-2.A7A  I2.A7A  OB  H20  (3.21  and  3.22) 

CALCULATION  OF  O/OHAX-PTN  REUTION  FOR  POSITIVE  PTN.  THE 
AIRUAYS  ARE  ASSUNEO  TO  EXPAND  UNIFORNLY  WITH  THE  PARENCHYNA 
AND  THE  TRANSNURAL  PRESSURE  IS  EQUAL  TO  THE  TRANSPULNONARY  PRESSURE. 

DPptV>(PTI«(AX-PTI«IN)/(  JNAX- 1 ) 

PTNlow-PTNNIN-OPHYS  lUsa  tha  exhalation  P-FVt  curve 

DETERNINE  AT  UHAT  J  VALUE  THE  PTN  BECONE  POSITIVE 
4*0 

SO  J»J*1 

Ppta  •  PTNlow»(J*1)*0PptHI 
IF(PptHi.LT.O.O)  GOTO  58 
4startB4*1 

IF(JsCart.EQ.O)  Jstsrtal 
JmxPTHsJNAX*  (  Jstart  •  1 ) 

J4«0 

00  60  4*Jstart.JHMX 

60  F0NAX<JJ)«FVt<J)**(1./3.) 

URITE(CRT,29)  (FDNAX(J},J«1,JmaxPTH) 

PAUSE'PAUSE  TO  LOOK  AT  FDNAX( 4), J«1, JmaxPTN' 

CALCUUTE  PARANETERS  NEEDED  FOR  THE  TUBE  LAW  (NEGATIVE  PTH's) 
FDHAX0«F0MAX(1) 

SLOPEO«OPptn/(FDNAX(2)-FONAX( 1 ) ) 

CHECKP>.001  iPressure  error  in  iteration,  cinH20 

DPHYSsQ.OO  I  Hysteresis  for  a  VC  breath 

CALCUUTE  THE  REGIONAL  VOLUNES,  TRANSNURAL  PRESSURES 
AND  AIRWAY  DIAFKTERS  BEFORE  THE  BREATH  STARTS. 

VELUNG>(V(1  )^1GHT)/VNIHLUNG 
FCLUNGsV(1)/TLC 
C  URITE(CRT,29)  V(1), WEIGHT, VMINLUNG.TLC 

C  PAUSE'PAUSE  TO  LOOK  AT  V(1),WEIGHT,VN1NLUNG,TLC’ 


477 


uuuuu  uu  ouuuuu  u  uuuuu 


Progrwn  8BB0LUS0.F0R 


DO  a 

a  DMMV(J)>OraUVO(J)/VCLUNe»(M.PHA-»BETA) 

C  WRITE(CIT.6)V(1).UE16HT,VNlNLUNG,FCLUNC,(0PGiUV(J).J«4,6) 

C  PAUSE'  PAUSE;  V(1),UEI6HT,VNINUING,FCLUMG.0P6RAV(J),J-4.6  ' 

K«1  IK«1  IS  THE  LUNG  VQLUNE  AT  STUART  OF  BREATH.  TIME>0 
T>0.0  ITINE  ZERO  IS  THE  START  OF  THE  BREATH 

C 

JstHtuMl  I  Inhalation 

Iprint«1 

CALL  STATUX(FClunB.Jatatua) 

CALL  TRANMPR(ONEGA,OPFG) 

CALL  AIRUAY(TRCONAX.TRCDIAN) 


CALCULATIONS  OF  THE  REGIONAL  FLOUS  AT  EACH  OT  TINE  IHCREHEHT 
INITIALIZE  PARAMETERS 

JCYCLEal  IJCYCLE>1  IS  INHALATION,  «•!  IS  EXHALATION 

JINSIGN>1 

JEXSIGN«-1 

Z  DEFINES  THE  AMOUNT  OF  FLOW  GOING  TO  EACH  OF  THE  AREAS  OF  THE  MODEL 

Z(1)>1.0  IZ  dafinaa  tha  fraction  of  flow  going  to 
Z(2)a0.5  (  a  ragion,  ZfRagion) 

Z(3)>0.5 

Z(4)-0.25 

Z(5}>.25 

Z<G)«.25 

Z(7)a.25 

PAUSE  'PAUSE  AFTER  THE  U  ARE  DEFINED' 

AT  T  •  0  THE  «rSTEN  IS  IN  ELASTIC  EOUILIBRIUM. 

THE  DIFFERENCES  IN  «J  AND  QL  IN  EACH  SET  IS  DUE  TO 
THE  DIFFERENT  AIRWAY  RESISTANCES 

K«1  IK>1  IS  THE  INITIAL  TINE  STEP  <Tim*0) 

T«0.0  ITINE  ZERO  IS  THE  START  OF  THE  BREATH 

MITE(LU0UT,31}X,V(1),(P(J),J>L,7),(V(J),J>4,7) 

URITE(LU0UT,2A99) 


1000  T»T*0T 
KaK«I 

IF(K.GT.OUX)  GOTO  5000 
DO  1002  J»1,7 

1002  V0(J>«  V(J) 

IF(K.LT.257)  GOTO  1003 
KKKbI 

1003  CONTINUE 

a(1)>FLOU<K)  I  0(1)  IS  FLOW  IN  THE  TRACHEA-TOTAL  FLOW 
A0sABS(0(1}} 

DELVOL«VOLIH(K)-VOLIN(K-1 ) 

V(1)>V(1)-»0ELV0L 

WRITE(CRT,32)  K,a(1).OELVOL,V(1} 

PAUSE'PAUSE  TO  SEE  K,a(1),DELVOL  AND  V(1)  FOR  THE  NEXT  TIME  STEP' 

CALCUUTE  THE  VOLUME  EXPANSION  OF  THE  LUNG  AND  THE  FOUR  REGIONS 
AND  THE  GRAVITATIONAL  EFFECT  ON  THE  REGIONAL  PARENCHYMAL  PRESSURES 

■  VE>(  V(  1  I GHT  )/VMI  NLUNG 

DO  1005  R-4,6 
VSXP>(RVE(R  )-HIVE(R-r  1 )  )/2 . 0 
1005  OPGRAV(R)-DPGRAVO(R)/VEXP**(ALPHA'rBETA) 
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C  WRITE(C>T,29)  (0raMV(R).R-4,6) 

C  PMISE'PMISE  TO  LOOK  AT  THE  DPRGAV(R),R«4,6' 

IF  (K.EQ.KEINS)  00  TO  3000 

1006  CONTINUE  I  return  after  aetting  exhetetion  values 
IF(JSTA0TN.EQ.2)  00  TO  1010 
l«ITE(CRT,U)  K.OID.OELVOL 
PAUSE'PAUSE  TO  LOOK  AT  K.  0(1).  OELVOL' 

IF(Afi.LT.SO.O)  00  TO  1010 
00  TO  1040 
1010  JOSTATIC>2 

JQSTATIC>2  INDICATES  OUASISTATIC  FLOW, FLOWS  <  50  cc/sec. 

USE  STATVOL  TO  CALCUUTE  THE  FLOW  RATES 

OELVOL-ASS(OELVOL) 

FCL4JN6>V(1)/TLC 

CALL  STATVOL(FClung,Jttatus) 

DO  1020  J>2,7 
DPRL(J>«0.0 
1020  RCV(J)«0.0 
00  TO  1405 
1040  CONTINUE 
JQSTATIC>1 

JOSTATIC-1  INDICATES  DYNAMIC  FLOW  (FLOWS  >  50  cc/sec). 

TO  OETERNINE  THE  REOIONAL  FLOWS  ITERATE  ABOUT  THE  FLOW  TO 
AREA  2  (0(2)).  HEED  TWO  OUESSES  FOR  0(2)  TO  SET  THE  ITERATION 
STARTED.  THE  FIRST  OUESS  01  IS  BASED  OH  THE  FLOWS  AT  THE 
PREVIOUS  TINE  STEP.  02  AND  03  ARE  THE  UTEST  GUESSES  FOR  0(2). 

THE  ITERATION  FUNCTION  F  IS  THE  ERROR  WHEN  THE  PRESSURES  IN  EQ. 

3.32  ARE  HOT  PROPERLY  BALANCED.  ONCE  THE  ERROR  IS  BELOW  CHECKP 
THE  ITERATION  IS  STOPPED. 

02«2(2)*0(1)  I  first  quess  for  0(2) 

06(2)eQ2  I  define  00(2)  and  00(3)  for  use  in 

06(3)a0(1)-0G(2)  I  REGVOL 

WRITE(CRT,29)  Z(2),0(1),02 
PAUSE'PAUSE  TO  LOOK  AT  2(2),0(1),02  IN  MAIN' 

A1«4  Ibeoinning  Area  for  PRESSLS  cslcutstions 
A2>7  lend  Area  for  PRESSLS  calculations 

LSIT«1  ILSITuation  >1,  1st  tisM  enter  PRESSLS  in  K  time  step 

CALL  PRESSLS(A1.A2.LSIT,02) 

CALL  RE6FL0W(CHECKP) 

LSIT  s2  FOR  ALL  OTHER  ENTRIES  INTO  PRESSLS 

DPRL  IS  THE  PRESSURE  DROP  FROM  THE  ALVEOLI  IN  THE  ITN 
POSITION  OF  THE  TRACHEA 

THE  FUNCTION  USED  IN  THE  ITERATION  IS  THE  ERROR  WHEN  THE 
PRESSURES  BETWEEN  AREAS  2  AND  4  ARE  NOT  BALANCED. 

IGUESSal 

OPRL(S)-OPR(S)«OPG(2,2) 

DPRL(7)>0PR(7)-»0PG(3,2) 

G^(5)-P(7)- (DP0RAV(5  )+0PGRAV(6)  ) 

F2^(0PRL(7)-DPRL(5» 

AF2«ABS(F2) 

IF(K.LT.71)  GOTO  1290 
c  mneatmiT.?)  k.lsit 

C  URITE(LU0UT,32)  IGUESS,F2,0PRL(S),0PRL(7),0PG(2,2),DPG(3,2) 

1290  CONTINUE 

C  URITE(CRT,29}  G,P(S),P(7),0PGRAV(5},DPGRAV(6),DPRL(5),SPRL(7) 

C  PAUSE'PAUSE  TO  LOOK  AT  G.P(S),P(7).0PGRAV(5),DPGRAV(6),DPRL(S) 
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C  *  .0ML(7),  RIAOV  TO  (SET  SECOND  (3UESS  FOR  0(2)  IN  MAIN' 

03^  lOsfint  03  in  cm*  AF2.LT.CHECKP 

IP(AF2.LT.CHECKP>  GO  TO  1400 
C  SECOND  GUESS 

IF(F2.6T.0.0)  Q3>1. 02*02 
IF(F2.LT.0.0>  03-0.98^2 
C 

1300  F1>F2 
Q1>02 
Q2>Q3 

I0UESS>IGUESS^1 

C 

0G(2)>0t  id*f{n*  06(2)  ml  06(3)  For  use  in  REGVOL  calc 
Q6(3)-Q(1)-Q6(2) 

WITE(CRT.»)  02,06(31 

FAUSE'PAUSE  TO  LOOK  AT  THE  NEXT  GUESS  FOR  02  AND  03  IN  MAIN' 
LSlT-2 
A1>4 
A2»r 

CALL  P6ESSLS(A1.A2,LS1T,Q2) 

CALL  REGFLaU(CHECXP) 

DML(5)a0M($)«0P6(2.2) 

OPRL(7)>OM(7)>OPG(3,2) 

F2-G»(0PRL(7)-0raL(S)) 

AF2«AIS(F2} 

WITE(CRT,15)  IJUNP 

URITE(CRT,29)  01 .02, FI , F2,0PRL(S) ,0PRL(7) 

PAUSE'PAUSE  TO  LOOK  AT  LC0UNT,al,02.F1,F2  IN  MAIN' 
IF(AF2.LT.CHECKP)  GO  TO  1400 

NEXT  GUESS 

Q3>(01*F2*Q2*F1 )/(F2*F1 ) 

(FCK.LT.TI)  GOTO  1390 
URITE(LUaUT,7)  K.LSIT 

WITE(LUaUT,32)  IGUESS,F2,DPRL(S),0PRL(7).0PG(2,2).DPG(3.2) 

1390  (XMTINUE 

IF(1GUESS.GT.2S)  GO  TO  5000 
GO  TO  1300 
1400  CONTINUE 

ITERATION  FOR  Ktfi  TIME  STEP  COVLETE 

a(2)«<a 

0(3)>a(1)-0(2) 

DO  1402  J«1,7 
1402  Z0(J)-Z(J) 

GOTO  1420 

1405  CONTINUE 

C  CALCUUTE  THE  Zs  FOR  THIS  TINE  STEP 

C  QUASI STATIC  CASE 

DO  1407  J>4,7 
0V(J)«V(J)-V0(J) 

1407  Z(J)-OV(J)/DELVOL  ICHANGE  MADE  CHECK  OUTI M ! I ! 1 1 1 • ! M 1) ■ ! 
SUM«Z(4)«Z(5)4-Z(6)-'-Z(7) 

DO  1408  J>4,7 

1408  Z(J)-Z(J)/SUH 
IFIJSTADTN.EQ.Z)  GOTO  2100 

DO  1410  J*4,7 
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U10  0(J>a0V<J)/DT 
Q(2)>0<4)4a(S> 

0(5)aO(«>-»«(7) 

OOTO  2100 

1420  CONTINUE 

C  OriUNlC  CASE 

DO  USO  >1.7 
1450  Z(J)aa(J)/FLOU(K) 

C  WITE(CRT,14)  K 

C  M1TE(CRT,29)  (Z(J).>1,7) 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  Zs  AT  THE  END  OF  THE  Kth  TIME  STEP' 

IF(JSTAOVN.EQ.I.ANO.JQSTATIC.EO.I)  GO  TO  1800 
IF(Q(1).Ea.0.0)  GO  TO  1800 
SISMI.O 
DO  ISM  J-4.7 
ISM  SUN«SUmZ(J) 

DO  1600  J>4,7 
1600  Z(J}oZ(J)/StM 
1800  CONTINUE 
1810  V0L0(1}-V(1) 

V0L0(2>>V(2) 

VOLO(S)-V(S) 

C 

C  INTEGRATE  THE  FLOU  TO  EACH  REGION  (AREA>4.7)  ANO  CALCULATE  THE 
C  HEW  RECOIL  PRESSURE  OF  THE  PARENCHYMA  OF  THAT  REGION 
C 

00  2000  J-4.7 
V0L0(J)-V(J) 

FVRES-V<J)/RTLC(J) 

IF(JQSTATIC.EQ.2)  GO  TO  1980 

IF(JSTADYH.EQ.2)  GO  TO  1980 

0V(  J)aOT/2.0*(Z0(  J  )*FLOU(K*  1  )-»Z(  J  )*FLOU(K)  ) 

V(J)-V(J)-»OV(J) 

I-O 

1820  r->i 

IFd.EQ.ImxFC)  G0TO1840 
FCI-FCMIN-K)FC*<I-1) 

IFLFCI.LT.FVREG)  GOTO  1820 
IF(I.EQ.I)  GO  TO  1830 

UU*FVREG-(FCI-OFC) 

P(J)-Pst(Jstatus.J.I-1) 

*  ♦  UU*(P8t<j8t8tll8.J.I)-Pst(JStatUS.J.I'1))/DFC 
GO  TO  1980 

1830  UU-FVREG-FCMIN 

P(J>-PSt(j8tatU8,J.1) 

*  *  UU*(Pst(J8tatu8.J.2)-Pst(Jstatus.J.1))/DFC 
GO  TO  1980 

1840  UU-FVREC-FCMAX 

P(J)-P8t(j8tatU8.J.lMXFC) 

*  UU*(P8t<J8tatu8.J.Iiiia*FC)-Pst<4status.J.Ima*FCM1))/DFC 

1980  CONTINUE 

PVCa(  V{  J  )  -  V0{  J  )  )/V0(  J  ) 

FTV«(V(J)-VO(J))/VOLIN(K) 

C  WRITE(CRT.ZI)  J.a(J).V(J).P(J).OPRL( J} 

C  PAUSE'PAUSE  TO  LOOK  AT  J.QC J).V< J).P<J),DPRL(J)' 

2000  CONTINUE 
C 

C  CALCULATE  THE  NEW  VOLIRKS  OF  AREAS  2  AND  3 
C 
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V(2)>V(«)«V(5) 

V<3)«V(6)*V<7) 

CALCUUTE  THE  VELOCITY  AND  OPt  IN  THE  TRACHEA  AHO  THE  lAt  GEN 

VTRACH>AIS(0( 1 )/( .785*TRC0IAN**2) ) 

CCIEF»-JCYCLE*0.0107 

DPFRaCOEF^d ,  1  )*VISCSTY/AU0<1 . 1  )*(U<  1 . 1  )*AHL(1 , 1  )/VISK>**0.5 
OPK>00»(F06^RACH**2*  1 . 7*U(  1 , 1  )**2) 

0PF6-0PFIH0P8E 

CALCUUTE  THE  TRANSNURAL  PRESSURES  AND  THE  NEW  AIRWAY  OIANETERS 
AND  LENGTHS  THAT  WILL  BE  USED  IH  THE  NEXT  TINE  STEP  K«1 

CALL  TRANMPRLONEGA.OPFG) 

C  PAUSE'PAUSE  BEFORE  YOU  ENTER  AIRWAY' 

CALL  AIRUAY(TRCONAX.TRCOIAN) 

C 

2100  CONTINUE 

IF(jaCLE.EQ.-l)  GOTO  2200 
IFdBOLUS.EQ.O)  GOTO  2300 

C  CALCUUTE  THE  AMOUNT  OF  INDICATOR  MATERIAL  THAT  ENTERS  EACH  REGION 

C0< 

JB«1 

2110  JB«JB«>1 

IF(JB.EO.JmxBPI)  goto  2120 

V0Ljl»(JB-1)*0Vbolus 

IF(VQLIN(K).6T.V0Ljb)  GOTO  2110 

UU«(VQLIH<K)-Va4B)/0Vbolut 

C«CBaUS(  JB- 1  )«UU*(CBOLUS(  JB)  -CB0LUS(4B- 1 )  ) 

GOTO  2130 
2120  IB0LUS«0 
OO 

2130  CONTINUE 

00  2140  J«4,7 

2140  ANaUNT(J)>AM0UNT(J)«0V(J)*(C^)/2.0 
GOTO  2300 

C  CALCUUTE  THE  GAS  CONCENTRATION  AT  THE  MOUTH  DURING 
C  EXHAUTION  (CONMO)  -  EACH  REGION  HAS  ROS  OF  ANATONIUL  DEAOSPACE 
C  AND  THE  UPPER  AIRWAYS  HAS  A  OEADSPACE  UAWDS 

2200  CONNO^.O 

00  2150  J>4,7 
FK-1.0 

RVEXH-VNAX(J)-V<J} 

IF(RVEXH.LT.ROS)  FK-0.0 
2150  CONMOM»NNO»FK*Z(J)*CbolREG(J} 

EXHV0L>VNAX(1 )-V(1 )>UAUDS 
URITE(LU0UT,30)  K.EXHVOL, CONMO 
URITE(CRT,30)  K.EXHVOL, CONMO 

2300  CONTINUE 

Iprint»Iprfnt+1 

WRITE(LU0UT,31)K,V(1),(P<J),J»4,7).(V(J),J^,7) 
URITE(LU0UT,31)K,O<1),(Z(J),J«4,7),<0PR<J),J=4,7) 
IFdPRINT.LT.IOOO)  GOTO  2900 
•lprint>0 

OELGRAVI  TY-0PGRAV<5  )-H)PGRAV(6  ) 

IF(JSTA0YN.E0.2)  GOTO  2500 
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C  CM.CUUTE  PULNQNMY  lESISTANCE 
DO  2400  J«4,7 

2400  RES(J)^>M(J>/(Q(J)*.001) 

RESI  -  0K(2,2)/(O(2)*.001)  «  (RES<4)*RES(5>}/(RES(4>«RES(S» 
RES11>  OP6(3,2)/(Q(3)*.001>  *  (RES(6)*RES(7))/(RES(6)-^RES(7» 

RESPUL>OPrG/(Q(1)*.0O1)  «  (RESl*RESn)/(RESt«RESIl) 

2499  FORMATC/) 

2500  CONTINUE 
MtlTE(LUCUT,2499) 

URITE(UnUT.2499) 

MITE(LU0UT,29)  0ELGRAVITV,DKRAV(S).0P6RAV(6) 

URITE(LU0UT.29)  0PR(4) .OMtS) .0PR(6) .0PR(7) .0PRL(S>.DI>RL(7> 
URITE(LUaUT,2499) 

C  URITE(LUaUT,29)  (XKM1( J), J-4.7) 

C  URITE(LU0UT,29)  (XK(4,H),N>2.HGEN0P) 

URITE(LUaUT,28)  PTM(1,1>.PTN(2,2},(PTM(4,N),H«3,NGEN0P) 
URITE(LU0UT,28>  AIO(1,1),AUD(2<2),(AUD(4.M),N>3,HGENDP) 
t«ITE(Unn’,28)  PTN(1,1),PTM(3,2),<PTN(7,N),N«3,MGENDP) 
WITE(LUaUT,28)  AUD(1.1).AUD(3.2),(AUD(7.H).M>3,NIXNDP) 
WITE(LUQUT,2499) 

URITE<LUQUT,35)  VTRACM.Ud.  1),U<2.2),UT3,2} 

MIITE<LU0Ur.35)  (U(4.N).H*3,NGEN0P} 

MtITE(LU0UT.35}  (U(7,N).N*3,MGENDP) 

WITE(LU(IUT,2499) 

tE(ITE(UIQUT,28)  0PFR.0PV(2,2).(0PV(4,N).N>3,MGEN0P> 
URITE(LUQUT,28)  DPBE.0PC(2,2).(DPC(4,N),N-3.N6EM)P) 
tMITE(LUQUT,28)  DPFG,0P0(2,2),<0PG(4,N),N-3,NGEN0P> 
URITE<UJ0Ur,2499) 

URITE(LU0UT,28}  0PFR«DPV(3,2),(DPV(7,N),N-3,NGEN0P) 
URITE(LU0UT,28)  DPBE,DPV(3,2).(DPC(7,N).N«3.NGENDP) 
URITE(LU0UT,28)  DPFG,DPG(3.2).(0PG(7,N),N«3,NGEN0P) 
V«1TE(LU0UT,2499) 

M(ITE(LU0UT,28)  (RE8(J),J«4,7),RES1.RES1I,RESPUL 
2900  MIITE(LUaUT.2499) 

00  TO  1000  I  goto  next  time  step  K'»’1 

3000  CONTINUE 
C 

C  START  OF  EXHALATION;  SET  THE  EXHALATION  PARAMETERS 
C 

JCYCLE*'1  lExftelecion  coefficient 

F0G*1.7 

Jstatus>2  lExhaletion  indicator 

C  MAKE  THE  INHAUTION  P-FV  CURVE  AN  INHALATION  OJRVE 

PTMNIN>PTNNIN-DPNrS 

PTNNAXbPTNNAX-DPHYS 

C  SAVE  THE  MAXIMUM  REGIONAL  VOLUMES 

VMAX(1)«V(1) 

DO  3100  J«4,7 
3100  VMAX(J)<iV(J) 

C  CALCULATE  THE  END  INHALATION  TRACER  CONCENTRATION  IN  EACH  REGION 

C  NORMALIZE  THE  AMOUNT  TO  1.0  microcurie 

SUN>0.0 
DO  3120  J>4,7 
3120  SUMaSUN«-AMOUNT(J) 

DO  3130  J*4,7 
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3130  «MauNr(J)«MIOUNT(J)/SUN 
00  3150  J-4.7 

CI0Lrra<J>«M<0UNT(J}/(V(J)-RDS> 

CKX.rra<<i:^1000000  *  CMLrcsCJ) 

URITECLUOUT.U)  J.V( J),CaOLr«fl(J).AMQUNT( J) 

3150  URtTE<CRT,U)  J,V(J),Ci0Lr«9(J).AN0UMT(J) 

PAUSE'PAUSE  TO  LOOK  AT  J,V(J),CIOLr«fl( J),AMOUttT( J)' 

fiOTO  1006 

4500  PAUSE' ITERATION  NOT  CONVERGINfil I  IGUESS-2S' 

5000  CONTINUE 
STOP 
END 


SUSROUTINE  INTERP(Y,INAX1,0X1,INAX2,0X2) 
DINENSIQNY(211).  Xl(211).  X2(601).  Y2(601) 

00  10  II  >  1.INAX1 

X1CI1)  «  <11  -1)*0X1 
10  CONTINUE 

00  20  12  >  1,INAX2 

X2(I2)  «  <12*1 >*0X2 
20  CONTINUE 

00  30  12  -  1.INAX2 

II  >  X2(I2)/DX1  ^  0X1/2.0 
II  ■  II 

IF(11  .EO.  1)  II  -  2 
IF(I1  .EO.  INAX1)  II  «  IMAXI  •  1 
U  «  <X2<I2)  -  X1(I1))/DX1 
01  «  Y(I1>1)  -  Y(I1-1) 

02  •  Y<11*1)  -  2.0*Y<I1)  ♦  Y<11*1) 
Y2<12)  •  Y(11)  ♦  0.5*0ini  ♦  0.5«02*U**2 
30  CONTINUE 

00  40  12  -  1.IIMX2 
T(12)  «  Y2(I2) 

40  CONTINUE 
RETURN 
END 


SUBROUTINE  FLOUW<KMAX,KEINS,VSTART) 

COMMON  FLOU<601},VOL1N<601).F<15),RTLC(1S),UL(2S).UD(25), 

♦  P1(201),V(7),AWL<7,18),H<7),Z<10),20(10),RCV<7),OVdt,COeFA, 

♦  AN0(7,18),O<7),P8t<2,7,151),PTM<7.30),0ENSITY,VISCSTY,VISK. 

♦  P<15),OPR<15),BES<15J,0PRL(15).0MAX<25),V0<15>,JCaUNT,U(7,20), 

«  V0LO<15).K,ImxFC,NUNITS,0FC,FCMIN.APGPL<2S),NGEN,0O,XLMAX(24), 

>  PER100,DT,TNAX,FCMAX,OELVOL,FDMAX<201).XKM1(7),XKC7,2S>, 

*■  DPG(7,18),RESC0N(7.18),RESVIS(7,18),JINSIGN,JEXS1CN,FCFRC,TLC, 

♦  0Ppm,lmxFCMl,JCYaE,PTMMIN,PTM(AX,VE,VMINLUNG,UEIGHT,DPI»AV(7). 
*■  FVt(201),lMxFCP1,Jmx,TXAR(7.30).POIS(7,30).FDMAX0,SL0PE0, 

♦  JSTAOTN,JOSTATIC,DPGRAVa(7),OFCS,OFC2,AMOUNT(7).GI,JliaxPTN, 

♦  NGENDP,NGENOP1,OK,9G(5),RWEIGHT<10),RVE(10),RNINVOLC10),QR(10). 

♦  0PVC7,30),DPC(7,30) 

INTEGER  CRT 
CRT>0 

1  F0RNAT(I3,F8.2.F8.3,F8.2) 

2  F0RMAT(9F8.1) 

3  F0RMAT(3X,I5) 

READ  THE  FLOW  DATA  FROM  THE  DATA  FILE  CALLED  FLOU.OAT 

JMX  -  *  OF  FLOW  DATA  POINTS  FROM  EXPERIMENTAL  RECORD 
VSTART-GAS  VOLUME  OF  THE  LUNG  AT  START  OF  BREATH 
DTC  «  TIME  INCREIffiNT  FOR  MEASURED  FLOW  DATA 
TIDVDL  >  MEASURED  TIDAL  VOLUME 
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Program  SBBOLUSD.FOR 


REiU>(4,1)  JmxQ,VSTART,DTC.T10VOL 
KEA0(4,2}  (FI.0W(I),la1,JmBxQ) 

URITE(CRT,1)  JimxQ,VSTART,DTC,TIDVOL 
URITE(CRT,2)  (FLOU(I). 1-1. Jmaxa) 

PAUSE'PAUSE  TO  LOOK  AT  Jmax.VSTART.OTC.TtOVOL  AND  FLOWS  IN  SUB  FLOUU' 
DETERMINE  WHERE  THE  MEASURED  DATA  BECOMES  NEGATIVE.  JEINS. 

JsO 

100 

IF(FLOW(J).GE.O.O)  GOTO  100 
JEINS«J-1 

DO  AN  INITIAL  SCALING  TO  NATCH  THE  FLOWS  TO  THE  TIDAL  VOLUME 

VSUMm.O 
DO  110  J>2. JEINS 

110  VSUM*VSUN«0TC/2*(FL0W(J-1)4.FL0W(J)) 

SCALE  a  TIOVOL/VSUM 
DO  120  Jal.jMXO 
120  FLOU(J)aSCALE*FLOW(J) 

INTERPRET  FLOW  DATA  TO  A  FINER  KMAX  GRID.  THE  TIME  STEP  DT  FOR  THIS 
US  BASEO  ON  AN  AVERAGE  VOLUME  INCREMENT  OF  OELVOL  OVER  INHALATION. 

jMXOlajMXO'l 

TMAXaDTC*JMxa'< 

TINEINH  a  (JEINS-1)*DTC 
OT«T IME I MH*<OVdt/T IDVOL ) 

KMAX1aTMAX/0T 

OTaTMAX/KNAXI 

KMAXaKMAXUI 

OTHaOT/2.0 

CALL  INTERPLFLOW.JmxQ.DTC.KMAX.DT) 

URITE(CRT,2)  <FLOW(I),Ial,KMAX) 

URITE(CRT.2)  DTC.DT 

PAUSE'PAUSE  TO  LOOK  AT  FLOWS  AND  DTC  AND  DT  IN  SUB  FLOWW' 

DETERMINE  THE  K  WHERE  THE  FLOW  FIRST  BECOMES  NEGATIVE, 

THE  END  OF  INHALATION  (KEINS).  LOOK  FOR  KCHECK  FLOWS  LESS  THAN  ZERO. 

KCHECKa3 

KCaO 

KaO 

130  K-K+1 

URITE(CRT,3)K 
IFTFLOWIKI.GT.O)  GOTO  200 
KC»KC+1 

IF(KC.Ea. KCHECK)  GOTO  250 
GOTO  150 
200  KCaO 

GOTO  ISO 

250  KEIHSaK-CKCHECK-D 

PAUSE'PAUSE  TO  LOOK  AT  ALL  THE  Ks' 

INTEGRATE  FLOW  TO  GET  TIDAL  VOLUME  BASED  ON  FLOW  DATA  (FTIDVOL) 

KEINSIaKEINS-1 
FTIOVOLaO.O 
DO  300  Kal.KEINS! 

300  FTIDVOLaFTIDVOL-KITH'CFLOWIKl^FLCAKK^I)) 
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Program  SBBOLUSD.FOR 


NORMALIZE  FLOWS  WITH  RESPECT  TO  THE  MEASURED  TIDAL  VOLUME 

SCALE-TIOVOL/FTIDVOL 
00  400  K-I.KMAX 
400  FL0W(K)-SCALE*FL0U(K) 

CALCULATE  THE  INHALED  VCH.UME  (VOLIN)  BASED  ON  THE  SCALED  FLOWS 

VOLIH(1)-0.0 
DO  500  K*2,ICNAX 

SOO  VOLIN(K)-VOLIH(K-1)'H)TH*(FLOW(K)-»FLOW(K-»1)) 


URITE(CRT,2>  (FL0W(K),K*1,KMAX) 

WRITE(CRT,2)  (V0LIN(K),K>1 ,KMAX) 

PAUSE'PAUSE  TO  LOOK  AT  VOLIN(K)  IN  SUB  FLOWW' 

RETURN 

END 


SUBROUTINE  TRANMPR(0MEGA,DPFG) 

COMMON  FLOU(601),VOL1N(601).F(TS).RTLC(1S),WL(2S),UD(25), 

*  P1<201},V(7).AWL(7,18),H(7).2(10>,Z0(10),RCV(7),DVdt,COEFA, 

*  AUD(7.18).O(7),Ptt(2,7.1S1).PTM(7.30),0ENSITY,V)SCSTY,VtSK, 

*  P(15).0PR(15),RES(1S).CPRL(1S).0NAX(2S),V0(t5>,JC0UNT,U(7,20), 

*  V0L0(15).K,IimxFC.NUNITS,DFC,FCMIN,APGPL(25),NGEN.DD,XLMAX(24), 

*  PERIGO,OT.TMAX,FCMAX,OELVOL.FOMAX(201),XKM1(7),XK(7.25). 

*  DPG(7,18),RESC0N(7,18),RESVIS(7.18),JINSIGN,JEXSIGN,FCFRC,TLC, 

*  0Ppta,lMU(FCM1,JCYCLE.PTMNIN,PTNMAX,VE,VMINLUNG,UEIGHT,DPGftAV(7), 

*  FVt(201),lMU(FCP1,JMX,TXAR(7,30),POIS(7,30),FDMAX0,SLOPE0, 
JSTADYN,JOSTATlC,DPGRAVO(7).OFCS,OFC2.AMOUNT(7).Gl,JmaxPTM. 

■»  N6EN0P.NGEN0PT,0K,0G(S),RtCIGHT(10),RVEO0),NNlNV0L(10},0R(10), 

*  0PV(7,30),DPC<7,30) 

DIMENSION  SUMDPG(IO), 11(10) 

INTEGER  CRT 
CRT^O 

1  F0RNAT(1X,9E8.2) 

2  F0RMAT(3X,214,F8.2) 

PAUSE 'PAUSE  AFTER  YOU  ENTER  TRANSMP' 

IF(K.NE.IOO)  GOTO  200 
Kia(>300 
200  CONTINUE 

JmajiMI  a  Jmm-1 
IF  (K.EQ.1)  GO  TO  4 
IF  (J0STATIC.E0.1)  GO  TO  8 
IF  (JSTADYN.EO.I)  GO  TO  8 

FOR  THE  STATIC  CASE  PTM  a  PARENCHYMAL  RECOIL  PRESSURE 

4  CONTINUE 
DO  6  Ja4,7 

DO  5  Nal.NGENDP 

5  PTN(J,N)aP(J) 

URITE(CRT,1)  (PTM(J,N),Na1.NGENDP) 

PAUSE'PAUSE  TO  LOOK  AT  PTNs' 

6  CONTINUE 
GOTO  100 

8  CONTINUE 

URITE(CRT,2)JCYCLE 
PAUSE'PAUSE  TO  LOOK  AT  JCYCLE' 

IF(JCYCLE.LT.O)  GO  TO  10 
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Program  SBBOLUSO.FOR 


DYNAMIC  CASE 

SET  XXN«1  AND  XK>1  DURING  INHALATION 

DO  9  J«4,7 
XKM1(J)>1.00 
DO  9  N>1,N6ENDP 

9  XIC(J,N)>1.0 
XK(2,2)-1.0 
XK(3,2)>I.O 
GO  TO  75 

10  CONTINUE 

CALCULATION  OF  XKM1-KM-1.  Ka  IS  A  FUNCTION  OF  THE  LOCAL 
COMPLIANCE  OF  THE  PARENCHYMA.  SEE  Ea.3.16. 

DO  SO  J>4.7 
RFV«V(J)/RTLC(J) 

JI>II(J) 

FR>RFV-FVt(JI) 

IF(FR)31.33,32 

31  JI>JI-1 

IF(FVt(JI).LE.RFV)  GO  TO  33 
GO  TO  31 

32  IF(JI.GE.JM)iMI)  GO  TO  33 
JI>JI+1 

IF<FVC(JI).GE.RFV)  GO  TO  33 
GO  TO  32 

33  II(J)  «  JI 
IF(JI.GE.Jmm)  JI>JmxM1 
C*<FVt(  JI+1  )-FVt<  JI  ))/0Pptlli 
XKMK  J)>2.0/(1 .0«aMEGA*C} 

ULCUUTION  OF  XK  •  THE  MEASURE  OF  THE  INTERDEPENDENCE 
8ETUEEN  THE  LOCAL  PARENCHYMA  AND  THE  BRONCHIAL  WALL. 

GENS  3-NGENOP 

DO  40  N«3,NGEN0P 
AUDUE-OHAX(N )*RFV**( 1 . /3 . } 

DSTAR  -  AHD(J,N)/AMDUE 
IF(DSTAR.GT.I.O)  DSTAR  -  1.0 
IF(0STAR.LE..7)  DSTAR  >  .7 

40  XK<J,N)»XICM1<J)*(1.25/(1.0+«0STAR-.7)/.15)**2)-.25)*1.0 

URITE(CRT,1)  (XK(JJ,N).N«3,NGEN0P) 

PAUSE'PAUSE  TO  LOOK  AT  (XK( JJ,N),N«3,NGEN0P)' 

50  CONTINUE 

GENERATION  2 


DO  60  J>2,3 
IF(J.Ea.2)  JJs5 
IF(J.EQ.3)  JJs6 
RFV>V(JJ)/RTLC(JJ) 

AUDUE-OMAX<N)«RFV«(1  ./3. ) 

DSTAR  «  AUD(J,N)/AUDUE 
IF(DSTAR.GE.I)  DSTAR  «  1.0 
IF(0STAR.LE..7)  DSTAR  -  .7 

XK<J,2)»XKM1<JJ)*(1.25/<1.0+((DSTAR-.7)/.15)**2)-.25)+1.0 
C  URITE(CRT,2)  XK(J,2) 

60  CONTINUE 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  XKs' 
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Program  SBBOLUSO.FOR 


7S  COMTIHUE 

CALCUUTE  THE  TRANSNURAL  PRESSURE  ACTING  ON  EACH 
BRONCHIAL  WALL.  SEE  EQ  3.15 

GENERATIONS  3>NGEN0P 

N1>NGENDP-2 
DO  85 

SUM0PG(J)>0.0 

DO  80  N-NGENDP.3.-1 

SUNDPGT J )«SUNDPG( J } -OPCC J , N) 

80  PTM(J,N)<iP<J)+JCYaE/XK(J,N)*SUMDPG(J) 

85  CONTINUE 

CALCUUTE  PTN  IN  GENS  1  AND  2  AND  THE  TRACHEA 

SUNDPG(5)>SUNDPG(5)-DPG(2,2) 

SUNDPG(6}>SUNDPC(6}-0PG(3.2) 

PTN(2.2)>P(5)«JCYCLE/XK(2,2}*SUH0PG(S) 

PTN(3,2)>P(6)-^JCYCLE/XK(3,2)*SUNDPG(6) 

SUMOPG(5)>SUM>PG(5 ) -OPFG 

PTN(  1 , 1  )>P(S)^  jaCLE*SUNDPG(S  ) 

PTNTRACN«P(5)4-jaCLE*SUM0PG(5) 

100  CONTINUE 
RETURN 
END 


SUBROUTINE  STATVQL(FC(una,Jstatus) 

THIS  SUBROUTINE  CALCUUTES  THE  FOUR  REGIONAL  VOLIMS  USING  AH 
ITERATION  SCHENE  (METHOD  OF  FALSE  POSITION).  THE  PROCEDURE 
STARTS  WITH  A  GUESS  OF  P(4).  THE  PRESSURE  AT  THE  C6  OF  THE 
HIGHEST  REGION.  THE  OTHER  PRESSURES  ARE  CALCUUTEO  USING  OPRAVO 
AND  THE  REUTIVE  VOLUME  EXPANSION  OF  THE  ENTIRE  LUNG.  THE  REGIONAL 
AND  TOTAL  VOLUMES  ARE  THEN  CALCUUTEO.  THE  ULCUUTEO  VOLUME  IS  THE 
COMPARED  TO  THE  REQUIRED  VOLUME, UHICH  IS  THE  ERROR.  THE  ITERATION 
SCHEME  PROCEEDS  ONCE  TWO  GUESSES  HAVE  BEEN  MADE. 

COMMON  FL0U(601),V0LIN(601),F(15).RTLC(15),UL(25),U0(25), 

*  P1<201),  V<7),AMl<r,  18),H(7},Z(10},Z0(10},RCV(7),0Vdt,COEFA, 

*  AUD(7,18).a(7),P«t(2, 7,151), PTN(7,30),DENSm.VISCSTY,VISK, 

*  P(15),DPR(15),RES(15),0PRL(15),0MAX(2S),V0(15),JC0UNT.U(7,20), 

*  VOLO(15),K,I«mFC,NUNITS,DFC,FCMIN,APGPL(25),NGEN,DD,XLMAX(24), 

*  PERIOO,DT,TNAX,FCNAX,OELVOL,FDMAX(201),XKM1(7),XK(7,25), 

*  0PG(7,18),RESC0N(7,18),RESVIS(7,18).JINSIGN,JEXS1GN,FCFRC,TLC, 

+  0Ppai,IamFCN1,JCYCLE,PTMMIH,PTHMAX,VE,VMINLUNC,UEIGHT,DPGRAV(7), 

*  FVt(201),IiMxFCP1,JMX,TXAR(7,30),POIS(7,30),F0NAX0,SLOPE0, 

*  JSTAOYN,JaSTATtC,OPGRAVO(7),OFCS,OFC2,AMaUNT<7),GI.JmxPTH, 

*  NGENOP,NGENOP1,DK,OC(5),RUEIGHT(10),RVE(10).RMINVOL(10>.QR(10), 

*  0PV(7,30),0PC(7,30) 

DIMENSION  FCR(7),VR(7),PR(7) 

INTEGER  R,CRT 
CRT>0 

1  FORMAT(3X,I5,4F10.2) 

2  F0RMAT(2X,I3,8E9.3) 

3  FORNAT(2X,8E10.3) 

IGUESS>1 

CHECKVb2.0  ITh*  calculatad  voIum  must  be  within  CHECXV  cc's 
of  the  actual  volune. 

USE  P-FVA  (PRESS-FRACTIONAL  VOLUME  OF  THE  ACINUS)  TO  GET  THE  1st  GUESS 
FOR  P(4)  (PRESSURE  AT  THE  CG  OF  REGION  4),  PI 
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c 

J-Jaax 

100  J>J-1 

IF(FVt(J).GT.FCLUNG)  GOTO  100 
PG1-I>TMNIIH’(4-1  )*DPptll 
P6RAV>DPGiMV(4)*OPGitAV(5>'H>f>GMV(6} 

PR(4)>  PG1«PGRAV/2  IPG1  IS  THE  FIRST  GUESS 

C  WtITE(CXT,2)  J,FVt(J),FaUN6.PTMNIN.PTNHAX.0Pptm,PR(4} 

C  PAUSE'PMiSE  TO  LOOK  AT  J.FVt<J).FCLUNG,PTNNlN.DPpt«,PR(4>' 

C 

C  CALCUUTE  THE  PRESSURES  IN  THE  THREE  LOUER  REGIONS 
C 

00  200  R-5,7 

200  PR(R)  >  PR(R-1)-DPGRAV(R-1) 

C  MtITE(CRT,3)  (PR(R),R>4,7) 

C  PAUSE'PAUSE  TO  LOOK  AT  Pfi(R),R>4,7  1st  GUESS' 

C 

C  CALCUUTE  THE  LUNG  VOLUME  FOR  THESE  PRESSURES 
C 

V0LCALC>0 
OO  300  R>4,7 


I«1 

2S0  I-I«1 

IF  (PR<R).GT.Pst(Jstatus.R,I))  GOTO  250 

UU-(PR(R)*Pst( Jstatus.R. I • 1 )) 

*  /(Pst(Jstatus,R, I )*Pst( Jstatus.R, 1*1)) 

280  FCH(R)«  FCMIH  ♦  <I-2)*0FC  ♦UU^FC 


VR<R)«FCR<R)*RTLC(R) 

VOLCALC  «  VOLCALC«VR(R)  IVOLCALC  fs  calculated  lung  volume 

C  URITE(CRT,2)  I,Pst(JstatUS,R,I),PR(R).FCR(R),RTLC(R>.FCNIN,DFC,U,VR(R} 
C  PAUSE'I,PST,PR(R),FCR(R),RTLC(R),FCMIN,OFC,U,VR(R)*  1st  guess' 

300  CONTINUE 

C  WRITE<CRT,3}  V(1), VOLCALC, ERR1 

C  PAUSE'  V(1), VOLCALC, ERR1  AFTER  1ST  GUESS' 

C 

C  OBTAIN  THE  NEXT  GUESS  FOR  P(4),  PG2 
C 

ERRIaVOLCALC-V(l)  lERRI  is  the  error  for  the  1st  guess,  PI 

IF(ERR1)400,500,450 

400  P62a:PGl>.25  IVOLCALC  too  small,  make  PG2  bigger  than  PG1 
GO  TO  500 

450  PG2«PG1-.25  IVOLCALC  too  big.  make  PG2  less  than  PG1 
C 

C  CALCUUTE  THE  PRESSURES  IN  THE  THREE  LOUER  REGIONS 
C 

500  PR(4)>PG2 
00  550  R-5,7 

550  PR(R)«PR(R-1)-0PGRAV(R-1) 

C  URITE(CRT,3)  (PR(R),R«4,7) 

C  PAUSE'PAUSE  TO  LOOK  AT  PR(R),R>4.7  FOR  NEXT  Gl^SS' 

C 

C  CALCUUTE  THE  REGIONAL  AND  TOTAL  LUNG  VOLUMES  FOR  THESE  PRESSURES 
C  . 

VOLCALC«0 
00  700  R>4,7 
I»1 
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650  l-l^l 

IF  (Pll(R).GT.Ptt(J>tatus.R,I))  GOTO  650 

UU«(PR<R)-Pst<Jstatus,R,I-1)> 

•  /(P«t(Jstatus.R.I)'Ptt(Jttatus,R,I-1)) 

690  FCR<R)>  FCNIN  *  <I-2)*0FC  ♦  UU^FC 
VR(R>>FCR(R}*RTLC(R) 

VOLCALC  •  VOLCALC-»VR(R) 

C  URITE(CRT,2>  l,Ptt(J8tatua,R,I).PR(R),FCR<R).RTLC(R).FCMIN.DFC,UU.VR(R) 

C  PMSE'PAUSE  TO  SEE  I,PST,PR(R),FC(R),RTLC(R),FCHIM.DFC.UU,VR(R)' 

700  CONTINUE 

ERR2>V0LCALC-V(1) 

AERR2*>AIS(ERR2> 
tF(AERR2.LT.CNECKV)  GOTO  1000 
URtTE(CRT,1)  iaUESS,PG1.P62,VOLCALC.ERR2 
PAUSE'  IGUESS.PG1  .PG2.  VOLCALC.  ERR2' 

USE  THE  ITERATION  SCHEME  TO  HAKE  THE  NEXT  GUESS.  PG3 

750  CONTINUE 

PG3«(PG1*ERR2-PG2*ERR1 )/(ERR2-ERR1 ) 

PG1«PG2 

PG2«PG3 

ERR1-ERR2 

I0UESS«IGUESS«1 

IF( IGUESS.lt. 25)  GOTO  800 

PAUSE*  I  GUESS-25  IN  STATVOL.  TYPE  CONTROL  C  AND  GET  OUTIH' 

KKK-I 

BOO  GOTO  500 
1000  CONTINUE 

DO  1100  R-4.7 
P(R)-PR(R) 

RVE(R>-(VR(R)4RUEIGHT(R»/RNINV0L(R) 

1100  V(R)-VR(R) 

V(2)«V(6)«V(S) 

V<3)-V<6)+V<7) 

RETURN 

END 


SUBROUTINE  AIRUAY(TRCOMAX.TRCOIAM) 

THIS  SUBROUTINE  CALCULATES  THE  AIRWAY  LENGTHS  AND  OIMtETERS  DURING  THE 
BREATH.  LENGTHS  ARE  BASED  ON  THE  REGIONAL  EXPANSION  AMO  DIAMETERS  ARE 
BASED  ON  THE  TRANSMURAL  PRESSURE  THAT  ACTS  ON  THE  AIRWAY. 

COMMON  FLOH(601).VOLIN(601).F(15).RTLC(15).WL(25).UD<25}. 

♦  P1(201>,y(7>.AWL(7,18),H(7),Z(10),20(10).RCV(7).0Vdt.C0EFA. 

♦  AUD(7.18).Q(7).P8t(2.7.1S1).PTM(7.30).0ENSITY.VISCSTY.VISK, 

♦  P(15).0PR(15),RES(15).DPRL(15).0NAX<2S). VOLTS), JC0UNT.U<7.20}, 

«  VDLO(15>,K,ImxFC,NUHITS.DFC.FCMIH.APGPL<2S),NGEN.DO.XLNAX(24), 

♦  PERIOO.DT,TNAX.FCNAX.DELVOL.FDMAX(201).XKM1(7).XK(7.25). 

♦  0PG(7.18).RESC0N(7.18).RESVIS(7.18).JINSIGH.JEXSIGN,FCFRC,TLC, 

*■  DPp»,ImxFCN1,JCYCLE.PTNNIN.PTMMAX.VE.VMINLUNG.WEIGHT,DPGRAV(7). 

♦  FVt(201).lBaxFCP1.jMX.TXAR(7,30).POIS(7.30).FDMAX0.SL0PE0. 

♦  JSTAOYN.  JOSTATIC.OPGRAVO(7).OFCS.DFC2.AMOUNT(7).CI .  JmbaPTM, 
N6ENDP,NGEN0P1.DK.QG(S).RWEIGHT(10).RVE(10).RMINVOL(10).OR(10). 

♦  0PV(7.30).0PC(7,30) 

INTEGER  CRT.R 
.  CRT-0 

1  F0RNAT(2X.8E9.3) 

2  F0RMAT(2X.I5) 

3  F0RMAT(2X.I4.4F9.3) 
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4  r0IMAT(2X,2lS,f10.4) 

CALCULATE  THE  LENGTHS  FOR  GENS  1  AND  2 
MtlTE(CRT.2>  R 

AULd.l)  ■  (V<1)/RTLC{i»**(1./3.)  •  XLNAX(I) 

AUL(2,2)  »  (V<2)/RTLC<2»**(1./3.)  •  XLMAX(2) 

AWL(3.2}  ■  <V<3j/RTLCC3))»*(1./3.)  *  XLHAX(2) 

PAUSEMN  AIRWAY,  AFTER  AHL(3,2)' 

CALCUUTE  THE  LENGTHS  FOR  GENS  3-23 

00  100  Ra4,7 

SCALE-(V(R)/RTLC(R))**(1./3.) 

URITE(CRT,3)  R,V(R),RTLC(R), SCALE 
DO  SO  H>3,NGEN0P 
ANL(R,H)>SCALE-XLMAX(N) 

NRITE(CRT.2}  R 

URITE(CRT,1}  (AWL(R,N),N>3,NGEN0P) 

PAUSE'PAUSE  TO  LOOK  AT  THE  AWLS' 
too  CONTINUE 

CALCULATE  THE  AIRWAY  DIAMETERS  FOR  THE  TRACHEA  AND  GEN  1  (AREA  2) 

TRCDIAM>  0.80*0. 056*PTM(1.1)  *  TRCONAX 
AUD<;i,1)>0.82*0.050*PTM(1,1)  *  0MAX(1) 

CALCUUTE  THE  AIRWAY  DIAMETERS  FOR  GEN'S  2-NGENDP 

PTM(4,2)aPTN(2,2)  tcalculate  PTM(j,2)  for  use  in  the  do  loop 
PTM(S,2)«PTN(2,2) 

PTN(6.2)«PTN(3,2) 

PTM<7,2)«PTM(3.2> 
if(k.LT.237)  GOTO  119 
KKKxl 

119  CONTINUE 

DO  200  R>4,7 
DO  160  N>2,NGENDP 
IF(PTM(K,ll).LT.0.0)  GOTO  150 

C  CALCUUTION  OF  AIRWAY  DIAMETERS  FOR  POSITIVE  PTM's 
I»1 

120  1-1*1 

PTT«PTMMIN*< I - 1 )*0Pptfll 
if(i.eq.jmxptm)  goto  130 
IF(PTN(R,N).6T.PTT)  GOTO  120 
UU-(PTM(R,N)-(PTT-OPpta))/DPptm 
SCALE-F0MAX( I - 1 )*UU*(FDMAX( I )- FDMAXC 1  - 1 )) 

GOTO  140 

130  UU-<PTM(R,N)-(PTT-OPptBI))/OPptBi 

SCALE-  FDMAX( JmwPTN)*UU-(  F0MAX(  JnaxPTM)-  FDMAX(  JmaxPTM- 1 } ) 

140  AUD(R,N)-SCALE*DMAX(N) 

GOTO  160 

C  CALCUUTION  OF  AIRWAY  DIAMETERS  FOR  NEGATIVE  PTM'S 
ISO  AUD(R,N)-FDMAXO*OMAX(N)/(1.-PTM(R,N)/SLOPEO)— (1./3.) 

160  CONTINUE 

IF(K.LT.IOOO)  GOTO  200 
URITE(CRT,2)  R 

URiTE(CRT,1)  (AUD(R.N),N-2,NGEN0P) 

UR1TE(CRT,1)  (PTN(R.N).N-2,NGEN0P) 

PAUSE'PAUSE  TO  LOOK  AT  THE  AUDS' 

200  CONTINUE 
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MI>(2.2)«MB(S,2) 

AUD(S.2)»AUD(6,2) 

RETURN 

END 

SUMOUTIie  PtlESSLS(A1,A2,LSlT.QLATEST) 

COMMON  FL0U(601 ) .VOLIH(601 ) . F(15) ,RTLC( 15),M.(25),UD{25) , 

*  F1(201).V(7),AM.(7,18),H(7).2(10).Z0{10).RCV(7).DVdt,COEFA, 

*  AUD(7,18>.O(7).l>st(2,7,151),PTM(7.30),0ENSm.VISCSTY,VISIC, 

>  P(15),DPR(15),RES(15),DPRL(1S),0MAX(2S),V0(1S),JC0UHT,U(7,20), 

*  V0L0(15>,K,Imu(FC,NUNITS.0FC.FCM1N.AP6PL(2S).NGEN,0D,XLMAX(24), 

*  PER100,DT.TMAX,FCMAX,DELVOL,FDMAX(201).XICH1(7).XIC(7,2S), 

*  0PG(7, 18) ,RESC0N(7,  18) .RESV1S(7,  18) , JIHSIGH. JEXSICN. FCFRC.TLC. 

*  0Ppt»,IawFCM1,JCYCLE,PTNNlN,PTNMAX,VE,MllNLUN6,UEICHT,DPCRAy(7>, 

*  FVt(201),lMxFCP1,Jinu(,TXAR(7,30),POIS(7.30).FOMAX0.SL0PE0. 
JSTAOYN.jaSTATIC,OP<iRAVO(7),OFCS,DFC2,AMOUNT(7),GI,JiMxPTH, 

*  H6EN0P.NGEN0P1,0K,a6<5),R(CI6Nr<10),RVE<10).RMINVOL(10),OR(10), 

*  OPV<7,30),OPC(7,3O) 

LSIT«1  CALCULATE  TOTAL  AIRWAY  AREAS  ANO  PRESSURES  FOR  ALL 

AIRWAYS  FROM  NGENOP  TO  GENERATION  2  (1*t  CALL  FROM  MAIN) 
LSIT«2  CALCUUTE  PRESSURE  CHANGES  IN  ALL  AIRWAYS  (UTER  CALLS 
FROM  PROGRAM  MAIN 

LSIT>3  CALCUUTE  PRESSURE  CHANGES  IN  AREAS  A1  ANO  A2  WHEN 
CALLED  FROM  REGFLQW 


INTEGER  CRT,AREA,A1.A2 
CRT-0 

1  F0RNAT(2X,7E10.3) 

2  FQRNAT(5X,3I10) 

WRI TE(CRT , 2)LSI T , NGENOP . N6EN0P1 

PAUSE'PAUSE  AFTER  YOU  ENTER  PRESSLS  AND  SHOW  LSIT.NGEMDP.NGENOPV 

PlE-3.1416 
PtE4aPIE/4 

SQ2P1>  1.4142*PIE*VISCSTY 

MGEMDP1-MCCWDP»1  IcRlculatet  velocity  for  an  extra  gen 

IFILSIT.HE.DGOTO  210  larcaa  already  calculated 

CALCUUTE  THE  CROSS-SECTIONAL  AREA  OF  THE  AIRWAYS  IN  EACH 
GENERATION  OF  EACH  OF  THE  AREAS 

CROSS-SECTIONAL  AREA  OF  GENERATIONS  3-NGENOP 

DO  150  AREA«A1,A2 
DO  100  H>3, NGENOP 

NAUPG-(2**N)/4  I#  of  Airways  Per  Generation  in  areas  4,5,6  and  7 
TXAR(AREA,N)«NAWPG*PIE4*AUD(AREA,N}**2 
K)  CONTINUE 

IF(K.LT.IOOO)  GOTO  ISO 
URITE(CRT,2)  AREA 

HRITE(CRT,1)  (TXAR(AREA,J),J-3,NG£N0P1) 

PAUSE'PAUSE  TO  LOOK  AT  THE  AREAS  OF  GENS  3-21' 

>0  CONTINUE 

AREA  OF  GENERATION  2 

NAUPG-2  INuifcer  of  Airways  in  gen  2  in  AREAS  2  and  3 

N«2 

DO  200  AREA-2,3 

TXAR(AREA,N)-NAUPG*PIE4*(AWD(AREA,N))**2 
C  WRITE(CRT,1)  TXAR(AREA,2) 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  AREA  IN  SECOND  GENERATION' 

200  CONTINUE 
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210  COMTINUE 
C 

C  CALCULATE  THE  GAS  VELOCITIES  IM  THE  AIEUAVS 

C  NOTE:  THE  GAS  VELOCITIES  IN  THE  Itt  GEN  ANO  THE  TRACHEA  ARE  HOT 
C  REOUIRED  FOR  THE  ITERATION.  THESE  ARE  CALOILATED  IM  THE 

C  MAIN  PROGRAM  TO  LOOK  AT  OVERALL  PRESSURES 

C 

C  FIRST  CALCULATE  THE  FLOUS  TO  ALL  AREAS  BASED  ON  THIS  GUESS-THE 
C  VARIASU  USED  IS  OR.  IT  IS  USED  ONLY  IN  PRESSLS  AND  REGVOL  TO 
C  SAVE  THE  FLOWS  BASED  ON  THE  LATEST  GUESS  FOR  0(2)  FROM  PROG  MAIN 
C 

IF(LSIT.EQ.3}  GOTO  220 

QR(2>"0LATEST 

QR(3>"0(1)-aR(2) 

QR(4)>2(4)*2*QR(2) 

aR(5>-OUTEST-QR(4) 

0R(6)>2(6)*2*QR(3) 

QR(7)-QR(3>*QR(6) 

GOTO  240 
220  CONTINUE 

0R(A1  )«fiLATEST  InMd  flows  for  A1  and  A2  when  called  from  REGFLOU 

J-A2/2 

QR(A2)««R(J)-aR(A1) 

240  CONTINUE 

C  URITE(CRT,1)  (QR(AREA),AREA«A1,A2) 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  REGIONAL  FLOUS  IN  PRESSLS' 

C 

C  CALCULATE  THE  GAS  VELOCITIES  IN  GEN  3-MGEHDP 

C 

DO  275  AREA«A1,A2 
00  250  N«3,NGEN0P 
U(AREA,N)*OR(AREA)/TXAR(AREA,N) 

250  CONTINUE 
C  WR1TE(CRT.2)  AREA 
C  URITE(CRr.l)  (U(AREA,J}.J>3,NGENDP1) 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  VELOCITIES  IN  GENs  3-21' 

275  CONTINUE 

IF(LS1T.EQ.3)  GOTO  310 
C 

C  GAS  VELOCITIES  IN  GEN  2  IN  AREAS  2  ANO  3 
C 

N>2 

00  300  AREA>2,3 

U(AREA,N)«QR(AREA)/TXAR(AREA.H) 

C  URITE(CRT,2)  AREA 
C  URITE(CRT,1)  QR(AREA),U(AREA,2) 

C  PAUSE'PAUSE  TO  LOOK  AT  OR  AND  U  FOR  THE  SECOND  GENERATION' 

300  CONTINUE 
C 

C  GAS  VELOCITY  IN  GENERATION  1 
C 

U( 1 , 1 >«ABS(Q( 1 )/( 1 -571*AUD( 1 , 1 )**2) ) 

C 

310  CONTINUE 
C 

C  CALCUUTE  THE  VINOUS  LOSSES  IN  THE  FLOU  USING  A  CORRECTED  EO  3.26 
C  OPV  IS  NEGATIVE  FOR  INHALATION; POSITIVE  FOR  EXHALATION 
C  INHALATION  FLOUS  PRODUCE  POSITIVE  VELOCITIES 

C  EXHAUTION  FLOUS  PRODUCE  NEGATIVE  VELOCITIES 

C 

C  VISCOUS  LOSSES  IN  GENERATIONS  3-NGOP 

C  • 

DO  400  AREA«A1,A2 
DO  350  N-3,li»ENDP 
A8VEL«ABS(U(AREA,N)) 
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RE«AtVEL*MI>(  MEA ,  N  )/V  I SK 

U1  a(32. 0*AUL  (MEA ,  N)  }/CltE*iU«(MEA.  N)  } 

U2>0ENSITY*U(AREA,M)**2 

l>0I$(AllEA.N)>6t«U1*U2 

U3«((RE*AUD(AREA.N)/AM.(AREA,N) )**(1 ./2. ) )/3.2703 

P0IS(AREA.N>ali3*P01S(AltEA,N) 

SQI(E>(>E*AyD(AIIEA.H)/AUL(AftEA.N))**(1./2.) 

COEFM-UCAREA,  M)*AM.  (AREA,  H)/AUD(  AREA.  N  )*a2 
OPV( AREA . N )aCOEFA*COEFB*SORE 

350  DPV(AREA.M)a6I*0RV(AREA.N)  Iconvart  DP  from  dynes/ca(**2  to  aM20 

C  URITE(CRT,2)  AREA 

C  URITE(CRT,1)  (0PV(AREA.N).N«3,NGEN0P> 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  OPVs  IN  GEHs  3-NGEN0P‘ 

400  CONTINUE 

IF(LSIT.Ea.3)  GOTO  510 
C 

C  VISCOUS  LOSSES  IH  GENERATION  2 

C 

N>2 

00  500  AREA«2,3 
ABVELaASS<U( AREA , N ) ) 

RE>ABVEL*AUD(AREA , N)/VI SK 
SQRE*(RE*AUD(AREA, H )/AUL( AREA , N) )•*( 1 . /2 . ) 

COEFB>-U(AREA, H)*AUL(AREA , N )/AUD( AREA , N )**2 
DPV(AREA,N)aCOEFA*OQEFB*SQRE 

0PV(AREA.N)>6I*0PV(AREA,H)  (convert  DP  froa  dynes/a«**2  to  cfl«20 
C  URITE(CRT,2)  AREA 
C  URITE(CRT.I)  RE,DPV(AREA.N) 

500  CONTINUE 

C  PAUSE'PAUSE  TO  LOOK  AT  RE  AND  OPVe  IH  GEN  2> 

510  CONTINUE 
C 

C  CALCUUTE  THE  CONVECTIVE  ACCELERATIONS  USING  EQ  3.28 
C  OPC  IS  POSITIVE  FOR  INHAUT10N;POSITIVE  FOR  EXHALATION 
C 

00  600  AREA«A1,A2 
OO  550  N«3,HGENDP 

DPC(AREA,N)>OK*(U(AREA,N- 1 )**2-U<AREA,N)**2) 

550  OPC(AREA,N)aGI*OPC(AREA,N)lconvert  dynes/cai**2  into  ca«2o 
C  «B(ITE(CRT,2)  AREA 
C  URITE(CRT,1)  (0PC(AREA,N),N«3,HGENDP) 

C  PAUK'PAUSE  TO  LOOK  AT  THE  DPC  FOR  GENs  3-NGENOP' 

600  CONTINUE 

IF(LSIT.Ea.3)  GOTO  710 
C 

C  CONVECTIVE  ACCELERATIONS  IH  GENERATION  2 

C 

N«2 

00  TOO  area-2,3 

0PC(AREA,N)-0K*(U(AREA,N-1)**2-U(AREA,N)**2) 
OPC(AREA,N}«GI*DPC(AREA,N)lconvert  dy^/cn— 2  into  anH2o 
C  UR1TE(CXT,2}  AREA 

C  URITE(CRT,1)  DPC(AREA,N) 

700  CONTINUE 

C  PAUSE'PAUSE  TO  LOOK  AT  DPC  FOR  GEN  2> 

710  CONTINUE 

C 

C  CALCUUTE  THE  TOTAL  PRESSURE  CHANGE  IN  EACH  REGION  (OPRL) 

C  AND  IN  GENERATION  2  (OPG) 

C 

C  CALCUUTION  OF  OPR 

C 

DO  800  AREA«A1,A2 
OPR(AREA)>0.0 
00  750  N>3,MGEN0P 
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DPG(AltEA,N)«OPV(AREA,N)'H>PC(MEA,M)  fOPG«OP  in  a  gen 
no  OPR(AREA)-OPR(AREA)«OPG(AREA,N) 

800  CONTIMUE 

C  MITE(CXT,1)  (DPIt(AREA),AREA-A1,A2) 

C  PAUSE'PAUSE  TO  LOOK  AT  THE  DPR  CALCULATED  IN  PRESSLS' 

IF(LSIT.EQ.3)  GOTO  910 
C 

C  CALCUUTION  OF  DPG  FOR  GENERATION  2 

C 

N>2 

DO  900  AREA-2, 3 

0PC(  AREA ,  2  >>OPV(  AREA ,  N  )-H>PC  (AREA ,  N  ) 

C  URITE(CRT.2)  AREA 

C  M1TE(CRT,1>  0PG(AREA,N) 

900  CONTINUE 

C  PAUSE'  PAUSE  TO  LOOK  AT  OPCs  FOR  AREAS  2  AND  3  CALC  IN  PRESSLS' 
910  CONTINUE 
RETURN 
END 

C . 

SUBROUTINE  REGFLOU(CHECKP) 

CONNON  FL0U(601),V0LIN(601),F(15),RTLC<15),WL(2S).WD(2S), 

♦  P1(201).V(7},AUL(7. 18), H(7), 2(10), 20(10), RCV(7),0Vdt,C0EFA, 

♦  AUD(7,18),Q(7),P«t(2,7,151),PTN(7,30),0ENSITy,VISCSTY,VlSK, 

♦  P(15),0PR(15),RES(1S),DPRL(15),DNAX(2S).V0(15).JC0UNT.U(7.20), 

>  VOLO(1S),K,IMXFC,NUNITS,OFC.FCNIN,APGPL(2S),NG£N,DO,XLNAX(24), 

>  PERIOD, OT,TNAX,FCNAX,OELVOL,FOMAX(201),XKN1(7),XK(7,2S>, 

♦  DPG(7,18),RESC0N(7,18),RESVIS(7,18).JINSIGH,JEXSIGN,FCFRC,TLC, 

♦  DPpW,IaaxFCN1,jaCLE,PTMMIN,PTNNAX,VE,VMINLUNG,UElGHT,DPGRAV(7), 
FVt(201),lMXFCP1,Jmx,TXAR(7.30),POIS(7,30),FDNAX0,SL0PE0, 

«  JSTADYN,J0STATIC,0PGRAV0(7),0FCS,0FC2,AHQUNT(7),GI,JimxPTN, 

♦  NGENDP,NGENOP1,DK,QG(5),RUEIGHT(10),RVE(10).RNINVOL(10),QR(10), 

♦  OPV(7,30),OPC(7,30) 

c 

c  THIS  SUBROUTINE  CALCUUTES  THE  FLOWS  WITHIN  AREAS  2  AND  3  FOR  A  GIVEN 
C  Q(2)  AND  0(3)  THAT  HAVE  BEEN  DEFINED  IN  THE  HAIN  PROGRAM 
C 

c 

INTEGER  AREA,A1,A2,CRT 

1  F0RNAT(2X,7E10.3) 

2  FORMAT(5X,3I5) 

CRT-0 

LSIT-3 

C  PAUSE'PAUSE  AFTER  YOU  ENTER  REGFLOW' 

C  URITE(CRT,1)  P(4),P(5),P(6),P(7) 

C  PAUSE'PAUSE  AFTER  YOU  PRINT  YOUR  Ps' 

C 

DO  1000  AREA-2,3 

A1-2*AREA  IA1  is  AREA  4  or  6 

A2-AU1  IA2  is  AREA  S  or  7 

C  HRITE(CRT,2)  A1,A2,AREA 

C  PAUSE'PAUSE  TO  LOOK  AT  A1.A2,AREA  AS  YOU  ENTER  REGFLOW' 

C 

C  THE  ITERATION  DETERMINES  THE  FLOW  IN  AREA  A1.  NEED  TWO  GUESSES  FOR 
C  THE  FLOW  IN  AREA  A1  TO  GET  THE  ITERATION  PROCESS  (METHCO  OF  FALSE 
C  POSITION)  STARTED.  FIRST  GUESS  IS  02  AND  IT  IS  BASED  ON  THE  LATEST 
C  GUESS  FOR  0(2}  FROM  PROG  MAIN.  ORs  ARE  CALCULATED  IN  PRESSLS  FOR 
C  THE  CASE  LSIT-1. 

C 

02-QR(A1) 

C 

C  NOTEiTHE  DPRs  FOR  THIS  GUESS  WERE  CALCULATED  JUST  BEFORE  THE  MAIN 
C  PROGRAM  ENTERED  REGFLOW.  THE  ITERATION  FUNCTION  (F)IS  THE  ERROR 
C  WHEN  EO.  3.32  IS  NOT  PROPERLY  BALANCED. 
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c 

G«P(A1 )  •P(A2>  •OPGIiAV<  A1 ) 

F2>fi«(Dra(  A2)  -OMCAI )  ) 

AF2-AIS(F2) 

IF<AF2.LT.CHECKP)G0T0  SOO 

GET  SECOND  GUESS  FOR  FLOW  TO  AREA  A1 

IF(F2.6T.0.00}  Q3«1.02^ 

IF(F2.LT.O.OO)  Q3>0. 98*02 
URITECCRT  1)  02  03  F2 

PAUSE'PAUK  TO  LOOK  AT  02.03, F2  FROM  THE  FIRST  OXSS  FOR  Q(A1)' 
LC0UNT>1 
200  F1>F2 
01*02 
02-03 

CALL  PRESSLS(A1,A2.LSIT,02) 

F2-G*(DPR(A2T*0PR( A1 ) ) 

AF2-AIS(F2) 

LC0UNT-LC0UNT*1 
MilTE(CRT,2}  LCOUNT 
URITE(CRT,1}  01,02, FI, F2 
PAUSE'PAUSE  AFTER  01, 02, FI. F2' 

IF(AF2.LT.CHECKP)  GOTO  SOO 

GET  NEXT  VALUE  OF  FLOW  TO  AREA  A1 

03«<01*F2-02*F 1 )/( F2 • FI > 

GOTO  200 
SOO  CONTINUE 
0(A1)-02 

0(A2)-QG(AREA)-02 
URITE(CRT,2)  A1,A2 
M(ITE<CRT.1)  0(A1),0(A2) 

PAUSE'PAUSE  AFTER  A1,A2,0(A1,0(A2):  ITERATION  FIHISHEDIII' 

1000  CONTINUE 
RETURN 
END 


Appendix  C  -  4 
Cocvection-Dififiision  Model 


program  CONDIF 


OIMENSION  C(4,501),C«lv<4.501), 

•  C0<101),C»O(101),Q«*e(10i),O<151J, 

•  HC101),F(101),THCTA1(101),THETA2(101), 

•  G(101),ALPHAl(101).AUPHA2(101),BeTA1<101),B£TA2(101). 

•  B1(101),B2<101),B3<101>,B4(101) 

OQMNOH  AVTO.AO,OT,OTH,02,TIOVOL.VLT,TL,TO.A(101), 

•  AV<101>,VZ(101>,AV2<201),FA<201),FAZ(201>,V0W,CC(151), 

•  FLOU<501),VailK501),Z<4.501),Rbjjg(4).R\rt<4).RV(4). 

•  H(AXl,TV,AyL<l01),AM0<101),Aso(101),V(151),F*lv(15n. 

•  VM(151),SO,Ctr«chO 


6  FORMAT  (10X,8E13.5) 

1NAX>101  !l»u**r  of  dioerete  points  on  the  gen  coordinate  sys 

1MAX1-INAX-1 

CALL  FLOMIdCMAX.KEINS.VSTART) 

CALL  SEONfVSTART.lNAX} 

C  INITIALIZE  VARIABLES 

DO  20  lal.INAX 
C(L,n»0.78 
C0(0)«0.78 
20  Calv(L.I)>0.78 

Ctrach0«0.78 

Cit**0.0 
Oiai^.25 
FLUX-0.0 
CNOUTH-T.O 
OZS«OZ**2 
OZH-OZ/2. 

T-O.O 
U-O 

P-OZS/DT 


iConcontratfon  of  N2  in  the  inspired  gas 
{Molecular  diffusion  coefficient  for  N2 


100 


00  100  I-1.INAX 
M(1}-A<I}/AUL(I} 

F(I)-A(1)*AUL(I) 

THETA1  ( 1  )»2*Aso(  1  >*0is*((A<  I  )/2+S0)*V8a(  I )) 
TMETA2(  I  )-OT/(2.0^sa(  I )) 


00  2000  K>2,KMAX 
T-T40T 

CMOUTHO-CMOUTH 

aO«FLaU(K'1) 

00  ISO  L-1.4 
C<L,1)»0,0 

IF  (VOLIH(K).GT.TV)  C(L,1)=Cin 


150  CONTINUE 

01»  0.37*ABS(FL0H(K))*AyD(1)/VZ<1)/0Z 
IF  (QO.GT.O.O.AND.K.GE.ICEINS) 

*  CALL  ENTRAMIK, REINS, 00, CMOUTH.CIL.D. FLUX) 


DO  1000  L*1,4 
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C  S  IS  TNE  LINEAR  SCALING  FACTOR  KTUEEN  THE  PREENT  VOLUME  OF  REGION  L 
C  AND  UEIREL'S  ANATOMICAL  LUNG  MODEL  DATA. 

IF(K.GT.2>  GOTO  170 
S-<RiM0(L)/VQU)**(  1  ./3.  > 

82^2 
S3iiS**3 
170  CONTINUE 

SO^ 

S(»-S2 

S03-S3 

Vrro^VO(L)«.S*(Z(L,K-1)*FLOU(K-1)*Z(L.O*FLOU(K)) 
S>((4.0*>Vrro)/V0U)**(1  ./3. ) 

S2i«^2 

S3-S«3 

DO  200  I>1.INAX1 
COdXa.l) 

Cso<  I  WCO(  I  Xal  v(L .  I )  )/2. 0 
aSK(I)>Z(L,K)*FLaU<K)*(1.-Falv(I)) 
a(IW(L.K)*(1-  FA<I)) 

200  CONTINUE 

DO  300  I-2,INAX1 

G(I)«  S*(0iiir*H(I-1)*0«*H(I))/2.0 

ALPMA1  ( I  )-SOroM<L  )/<S3-  THETA2<  I  )*Qmc(  I  )4-S*THETA1  ( I )  ) 

ALPNA2(  I  )><THETA2(  I  )«asK(  I  )*SnHETA1  ( I )  )/ 

•  (S3-TI«TA2(I>*Qmc(I)«S*THETA1(I)) 

RETA1  ( 1  )«Vm(  I  )/DZ*(S3*ALPHA1  ( I  )-S03*Cso(  I )  ) 

300  ■CTA2(1)«Vm<I)/OZ*(S3*ALPHA2(I)) 

C  CALCUUTE  THE  COEFFICIENTS  TO  THE  DIFFERENTIAL  EQ 

DO  400  I>2,tNAX1 

II  ( I  )«•  (G<  I  )-»G(  I  *  1 )  )/2 .0-DZHTOL I  •  1 ) 

I2(  I  )"P«<83*F<  I  )«6ETA2(  I )  )-»(6(  I  )-»G(  I4>1 )  )/2+(G<  I  •  1  )*G<  I )  )/2. 0 
l3(I)>-(G(IX(I«1))/2.0*0ZHro(l4-1) 

400  B4(I)«P*(S0*F(I)*C0(I)-IETA1(I)) 

C  SET  THE  BOUNDARY  CONDITIONS  AN  I>1  AND  AT  I>1MAX 

B1(1)«0.0 

B2(1)«1.0 

B4<1}«C(L,1} 

IF  (QO.LT.O.)  B1(1)-1.0 
IF  (QO.LT.O.)  B4(1)«FLUX/01 
B2(INAX)>1.0 
B3(INAX)>1.0 
B4(INAX)>0.0 

C  SOLVE  THE  TRIDIAGONAL  MATRIX  TO  GET  THE  CONCENTRATIONS  ALONG  THE 
C  TIK  AIRWAY  WITHIN  THIS  REGION  (C(L)) 

DO  500  I«1,INAX 
500  CC(I>-C(L,I> 

CALL  S0LVE(B1,B2,B3,B4,1MAX,CC) 

DO  600  I«1.INAX 
600  C(L.I)>CC(I) 

IF  (O0.6T.0.0)  CALL  ENTRAN(K,ICEINS,aO,CMOUTH,C(L.1),FLUX) 

1000  CONTINUE 
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2000  CONTINUE 
STOP 
END 


SUNNQUTINE  6BM(VSTART.IIMX) 

THIS  SUNROUTINE  CALCULATES  THE  ANATOMICAL  VARIABLES  THAT  ARE  USED  IH 
THE  OONVECTION/DIFFUSION  MODEL 

COMMON  AVT0.A0.DT.0TM.0Z,TI0V0L,VLT,TL,TD,A(101>. 

•  AV(101).VZ(10t).AVZ<201},FA(201}.FAZ(20t>.V0U.CC(151>, 

•  FL0IKS01 ) ,V0LIN(501 ) ,2(4,901 ) ,Rb«g(4) ,RV0(4),RV(4) , 

•  INAX1,TV,AUL(101),Aia(101),Ato<101),V<151),Fa(v<151), 

•  VH(151),S0,Ctrach0 

DIMENSION  Valv(1S1),Svalv(1S1),SvalvZ(151),SMl(1S1),SwlZ(1S1) 

C  INWT  THE  ANATOMICAL  DATA 

TOW-1.8 

TLW>22.0 

REA0(9,1)  (AUL(N),N«1,23) 

READ(5,1)  (AIO(N},N«1,23) 

1  FORMAT! 13F6.3) 

2  F0RMAT(7F11.0) 

00  10  N-1,16 
10  VHlv(N)aO.O 

REA0<5,1)  (V«(v(N),N*17,23>IAlv«>lsr  volUM  p*r  gmeration 

0-0.032  ISrc  Oaoth  in  cm 

Valunit>0.00002671  IVoluM  of  on  ALvMlor  UNIT  a3 

AMD-  0.00052  lArM  of  •  Sac  OPaning 

C  INTERPOLATE  THE  ANATOMICAL  DATA  FROM  THE  23  GERHERATION  GRID 
C  TO  A  FINER  GRID  OF  IMAX  POINTS. 

FIMAXI-IMAXI 

DZ-23./FINAX1 

Aso(1)-0.0 

SValv(1)-0.0 

SVcau-O.O 

V(1)>0.0 

A(1)>0.0 

SaMl(1}>0.0 

DO  20  INi2,24 

SaHUN}«SaHUN-1)'»AUL(N)ISuHWd  lungth  of  conductin  airways 
FNUN-(2**N)/4.0  If  of  airways/gan  in  a  ragion 

A(N)-FIR*ra.1416*(AUD(N>**2}/4.ICross-sactienat  area  of  con  aw 
SVeaii-SVcawtA(N)*AU.(N)  ISuawd  vol  of  con  airways 
SValv<N)«SValv<M-1)*Vaiv<M)ITuMsd  vol  of  alvaoli 
20  V(N)-SValv(N)«SVcaw  ISuwMd  vol  of  alvaoli  and  airways 

00  29  N«1,24 

Falv(N)-Valv(N)/V(24)  lAlvaolar  vol/gan  as  a  fraction  of  tot  vol 
25  FA(N)«V(N)/V(24)  IFrMtion  of  tha  total  volusa 

CAU  0ERIV(FA,24,1.0,FA2) 

CALL  0ERIV(SValv,24,1.0,SValvZ) 

CALL  0ERIV(Sawl,24,1.0,SawlZ) 

CALL  DERIV(V,24,1.0,VZ) 
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DO  28  N>1,2A 

IF  (N.LT.17)  SVa(vZ(N}>0.0 
28  IF  (FA<N).6T.1.0)  FA(H)>1.0 

00  50  l|a>2,24 

llaac^alvZ(N)/(A.O*Valun<t)  li  of  saea  par  ganaratlon  in  a  ragion 
Aao<N)^laopm8ac  llaglonal  Araa  of  aac  opaninga/ganaration 

50  AfM}<iVZ(M}/Saw(2(N) 

CALL  INTERF(FA,24.1.0,IIMX,OZ) 

CALL  INTfllP(FAZ,24,1.0,INAX,DZ} 

CALL  lliTEM(SValvZ,24,1.0,INAX,DZ) 

CALL  INTERPfSaulZ.ZA.I.O.INAX.OZ) 

CALL  lliTEI(P(VZ,24,1.Q,IMAX,DZ) 

CALL  IIITERF(A,24.1.0.INAX,OZ) 

CALL  INTEIIP(V,24.I.0,INAX,0Z} 

C  SCALE  UEIIEL'S  DATA  TO  SUBJECT'S  LUNG  STARTING  LUNG  VOLUME 
VQWi^S. 

SCAU«<VSTART/V0U)**(1  ./3. ) 

CALCUUTE  THE  NEW  TRACHEA  GEOMETRIES 

TD-TOWnCALE 
TL-TLU*SCALE 
AOO.U16*TO*^«. 

TV»TL*A0 

FORMAT  (11E11.3) 

RETURN 
END 


SUMOUTINE  FLOMKOWX.KEINS.VSTART} 

THIS  SUBROUTINE  READS  IN  THE  FLOW  AT  THE  MOUTH,  AMD  THE  REGIONAL 
FLOWS  AND  VOLUMES  THAT  WERE  CALCULATED  IN  THE  VENTIUTION  MODEL 

COMMON  AVT0,A0,0T,0TH,0Z,TI0VQL,VLT,TL,TD,A(101), 

•  AV(101),VZ(101).AVZ(201).FA<201),FAZ(201),V0U.CC(1S1}, 

•  FL0W(50T),vaiN(501).Z(4,501).Rbag<4),RV0(4).RV<4), 

•  IIIAX1,TV,AUL(101),AUD(101),Aao(101),V(15T),Falv(151>. 

•  Vsa(151).S0,Ctradi0 

INTEGER  CRT 
CRT-0 

F0RNAr(l3,F7.2,F7.1) 

F0RNAT(9F8.1) 

F0RMAT(3X,I5} 

READ  THE  FLOW  DATA  FROM  THE  DATA  FILE  CALLED  FLOW.OAT 

JNAX  >  f  OF  FLOW  DATA  POINTS  FROM  EXPERIMENTAL  RECORD 
VSTART  •  GAS  VOLUME  OF  LUNG  AT  START  OF  INHAUTION 
OTC  ■  TINE  INCREMENT  FOR  MEASURED  FLOW  DATA 
TIDVa  •  MEASURED  TIDAL  VOLUME 
RV(L>«  REGIONAL  VOLUMES  FOR  REGIONS  L-T,4 
FLOW(J)  ■  MEASURED  FLOWS  AT  THE  MOUTH 
Z(L,J>  ■  FRACTION  OF  FLOW  GOING  TO  EACH  REGION  L  AT  TINE  J 

INPUT  FLOW  DATA 

'NI5-5 

C  OPEN  INPUT  FILE  'EXPFLOU.DAT' 
aPEN<NI5,FILE-'EXPFlOW.OAT' ) 

REA0(NI5,1)  JMAX,DTC,TIDVOL 
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Prooram  CONDIF.FOR 


KMXHIS.Z)  (RV(L).L*1,4) 

VSTART-RV<1)««V(2)-»RV(3)'HtV(4) 

DO  40  L-1.4 

40  ltbts<L)aRV(L)  IS«t  tngimfng  voIimm  for  each  Region  L 

REM>(NI5,2)  (FL0W(J).J>1,JNAX) 

DO  SO  L>1,4 

50  R»D<NIS,2)  (Z(L,J).J«1,JNAX) 

URITE(CRT,1)  JNAX.VSTART.OTC.TIOVOL 
URITE(CltT,2)  (FL0U(J),J«1,JMAX) 

FMKE'PMJSE  TO  LOOK  AT  JMAX.VSTART.OTC.TIDVOL  AND  FLOWS' 

DETnWINE  WHERE  THE  NEASUED  DATA  BECOMES  NEGATIVE,  JEINS 
JaO 

100  jBj^l 

IF(FLaH(J).GE.0.0)  GOTO  100 
JEINS-J 

INTERPRET  FLOW  DATA  TO  A  FINER  KMAX  GRID.  THE  TIME  STEP  FOR  THIS 
IS  BASED  ON  AN  AVERAGE  VOLUME  INCREMENT  OF  OELVOL  DURING  THE  INHAUTION 
PART  OF  THE  BREATH. 

JNAXIMMX'I 

TNAX*OTC*JNAX1 

DELVQLbZO.O  leverage  volun  IncreeKnt  In  cc's  for  tiae  step  DT 

TIMEINH  •  (JEINS-1)*0TC 

0T-TINElNH*(0ELVQL/Tt0V0L) 

niAXl>TNAX/DT 

DT-TNAX/KNAXI 

KNAXXGMXUI 

DTIMT/2.0 

CALL  INTERP(FLOU.JMAX,OTC,niAX,DT) 

WRITE(CRT.2)  (FL0U(I),I>1,nMX) 

URITE(CRT,2)  DTC.DT 

PAUSE'PAUSE  TO  LOOK  AT  FLOWS  AND  DTC  AM)  OT  IN  SUB  FLOWW' 

DETERMINE  WHEN  THE  FLOW  FIRST  BECOMES  NEGATIVE,  THE  END  OF  INHALATION. 
LOOK  FOR  KCHECX  FLOWS  LESS  THAN  ZERO. 

KCNECK«3 

KC>0 

K>0 

ISO  K>K4'1 

C  URITE(CRT,3)K 

IF(FLOW(K).6T.O)  GOTO  200 
KC>KC«1 

IF(KC.Ea.KCHECK)  GOTO  250 
GOTO  150 
200  KOO 

GOTO  150 

250  KEINS>K*(KCHECX*1) 

C  PAUSE'PAUSE  TO  LOOK  AT  ALL  THE  Xs' 

C  INTEGRATE  FLOWS  TO  GET  TIDAL  VOLUME  BASED  ON  FLOW  DATA  (FTIDVOL) 

KEINSt-KEINS-l 
FTIDVOL-O.O 
DO  300  K«1  KEINS1 

300  FTIOVaL>FTioVOL-K>TH*(FLQU(KHFLOW(K^1)) 
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C  NOMMLIZE  THE  FLOUS  WITH  RESFECT  TO  THE  MEASURED  TIDAL  VOLUME 

SCALE-TIDVOL/FTIDVOL 
DO  400  K«1,KMAX 
400  FLOU(K)aSCALE*FLaU<K> 

C  CALCUUTE  THE  IHHALO  VLUME  (VOLIH)  EASED  OH  THE  SCALED  FLOUS 

VOLIM(1)aO.O 
DO  500  Kb2,ICNAX 

500  VOL1H(K>«VOL1  H(K- 1 1-HITH*!  FLOU(K- 1  )-»FLQU(K)  > 

URITE(CRT,2)  (FLOU<K).K>1,0IAX) 

URITE(CRT,2)  (VOLIM(K).K«1,KMAX) 

PAUSE'PAUSE  TO  LOOK  AT  FLOU(K)  AHO  VOLIH(K)  IH  SU8  FLOUW' 

RETURM 
EHO 


SUBROUTIHE  EIITRAM(K,KE1HS,Q0,CMQUTH,CTRACH,FLUX) 

COMMON  AVT0,A0.0T.0TH,D2.TI0Va,VLT.TL,TD,A(t01). 

•  AV(101),VZ(101).AVZ<201).FA(201).FA2(201),V0U,CC(151). 

•  FLOUCSOI )  .VOLINCSOI )  .2(4,501 )  ,Rbao(4)  ,RV0(4)  .VR(4). 

•  INAXl.TV,AUL(101).AUD(101).Aao<101).V(151),F«lv(151>, 

•  VMdSD.SD.CtrachO 

DIMENSION  C(201},CO(2O1}.SOC(201> 

AiaOMBS(FljQU<K)) 

RETMOOnO/AO/O.IS 

FK>0.05/(2.14*ALOQ(RET)*3.6) 

0«FK*TD*AQ0/A0 

IMAX*21 

1NAX1>IMAX'1 

FIMAX1*INAX1 

DX-TUFINAXI 

NT«1.*2.«IW>T/0X^ 

FNTaNT 

L>0.5«(AM/A0)«0T/FNT/DX 

FL»L 

DX-(AiQO/AO}*(OT/FNT  )/FL 
DX2«0X^ 

INAX>TL/DX^1.5 

IIIAX1*tNAX-1 

W)*(DT/FNT)/0X^2 

WRITE  (6.18)  NT, INAX,L,0X,0,P, (MOUTH, CTRACH 
18  FORMAT  (5X,315,8E14.3) 

Ll-L+1 
INL-INAX-L 
INL1«IML-d 
NUMJaKElNS 
00  15  I>1,INAX 
IS  C(I)-0.0 
20  CONTINUE 
IQ(MO/AM 
NCTC>H(K-1)/NUNJ 
JCTC1>U(NaC-1>«NUMJ 
IF  (K.EO.JCYCI)  C(1)>(1.«C(1))/2. 

CTRCNCMCINAX) 

00  80  IRil.NT 
80  25  I>1.IHAX 
25  CO(I)>C(I) 

00  30  Ib2  I maxi 

30  SDC(I)aC0(I*1>-2.*C0(I}^0(I«1) 

S0C(1)>1.>2.*C0(1)^(2) 
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S0C(IIMX)««>C(IIMX1) 

IF  <IQO.LT.O)  GO  TO  40 
DO  32  I>1.L 
32  C(l)«1.0 

00  35  I«L1,IIMX 
IC»I-l 

35  C(1)>C0(K)«D*S0C(IC) 

CTRACN-CdlWX} 

GO  TO  60 
40  CONTINUE 

C(llMX)aCtr«ctiO  ♦N*(CTI(ACH-CtrachO)/FNT 
DO  50  I«1,1NL 
K«I>L 

50  C(I)>CO(K)«PnDC(K) 

DO  55  l>INL1,INAX 
F«(t>INL)/FL 

55  C(I)aC0<INAXW*(C(INAX)-C0(IfMX)) 

60  CONTINUE 
80  CONTINUE 

FLUXaO*(C(  MAX) -C(  INAX- 1 )  )/0X 
CHQUTIMd) 

90  FONNAT  (10E11.3) 

100  CONTINUE 

EETUNN 

END 

C . 

SU8MUTINE  INTERP(Y. MAXI, 0X1, MAX2.0X2) 

DIHENSION  T(201).X1(201),X2(201),Y2(201) 

DO  10  I1«1,MAX1 
10  X1<I1)«<I1*1)*0X1 

00  20  I2«1.MAX2 
20  X2(I2)«<I2'1)*DX2 

DO  30  I2>1,MAX2 
l1>X2<l2)/OX1«OXl/2. 

I1-I1+1 

IF  (I1.E0.1)  11-2 

IF  (I1.EO.MAX1)  I1-INAX1-1 

U-(X2(I2>-X1(I1))/DX1 

D1«Y(I1*1)-Y<11-1> 

02-Y<IU1)-2.*Y(I1)>Y<I1-1) 

30  Y2<I2)-Y<I1)*.5«01*U*.5*02*U«2 

DO  40  12-1,  MAX2 
40  YCI2)-Y2(I2) 

KETURN 

END 

C . 

SUBROUTINE  S0LVE(A,B.C,0,NUN,U} 

OINENSION  A(201 ) ,B(201 ) , C(201 ) ,0(201 ) ,U(201 ) 
A(1)4A<1)/B(1) 

0(1)«(1)/B(1) 

A(NUN}-0.0 

U(NUN4-1)-0. 

DO  10  N-2,NUN 

A(N)-A(N)/(B(N)-C(N)*A(N-1)) 

10  D(N)-(0(N)-»C(H)«0(N-1 )  >/(B(N)-C(N)*A(H- 1 )  } 

DO  20  N-1,NUN 
K-NUN4^1-H 

20.  U(K)-A(K)*U(Kd)-K)(K} 

RETURN 

END 

C . 

SUBROUTIIK  0ERIV(FUN,NUM,H,DFUH) 

OINENSION  FUN(201),0FUN(201) 


Proflram  CONOIF.FOR 


NbNUN'Z 

OFUN(1}«(-25.0*nM(1)/12.0H.O*nM(2)*3.0*HM(3)«4.0*FUN(4)/3.0 

•  •nM(S)/4.0)/N 

0nM(2)«(  •  nM(  1  )/4 .0-5 .0*FUN(2)/6.(H3. 0*FUir(3)/2.0-  nMI(4  )/2. 0 

•  ♦FUN(5)/12.0)/H 
DO  10  IM  N 

10  DnM(IK2)«(nM(H-2)/12.0-2.0*nM(N- 1  )/3.0»2.0*nM(N4l  )/3.0 

•  -nM(IK2)/12.0)/H 
ORM(IMI-1>><n«(IMI)/4.0»5.0*FUI(MM-1)/6.0-3.0*FUN(IIUN-2)/2.0 

•  4>FUN(NUM-3)/2.0-nM(NUN-4)/12.0)/H 

DnM(IIUN>>(2S.O*FUN(NUN)/12.0-4.0*nM(IIUN-1)^3.0»nM(NUM-2) 

•  •4.0*FUN(NUN-3)/3.(HnW(NUN-4)/4.0)/K 

nmjRN 

END 
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Appendix  D 

Cardiovascular  Computer  Programs 


PROGRAM  CVMODEL 


..  PMISIUN  CVNUEL  CALLS:  (1)  SUBSflUTlNE  INITAL  TO  DEFINE  THE  OOE 
..  INITAL  COMOITIONS,  (2)  SUWOUTINE  RKF45  TO  INTEGRATE  THE  ODES, 

..  AND  (3)  SUIROUTINE  PRINT  TO  PRINT  THE  SOLUTION. 

!!  THE  FML0WIN6  COOING  IS  FOR  500  ODES.  IF  NONE  ODES  ARE  TO  BE  IHTE- 
..  GRATED.  ALL  OF  THE  SOO'S  SHOULD  BE  CHANGED  TO  THE  REQUIRED  NUMBER 
IMPLICIT  DOUBLE  PRECISION  (A-H),  DOUBLE  PRECISION  (0-2) 

INTEGER  HI,  NO,  NEON,  NSTQP,  NQRUN 

OOMMON/T/  T,  NSTOP,  NORUN,  PP,  TIM 

1  m  T{500) 

2  /F/  F<500) 

!!  TNE  NUMBER  OF  DIFFERENTIAL  EQUATIONS  IS  IN  COMMON/N/  FOR  USE  IN 
SUBROUTINE  FCN 

OOMMON/N/  NEON  I  TWO  EQUATIONS  PER  VASCULAR  SEGMENT 

!  COMMON  AREA  TO  PROVIDE  THE  INPUT/OUTPUT  UNIT  NUMERS  TO  OTHER 
..  SUNROUTINES 

OONNON/IO/  NI.  NO 

!!  ABSOLUTE  DIMENSIONING  OF  THE  ARRAYS  REQUIRED  BY  RXF45 

THE  USER  MUST  PROVIDE  STORAGE  IN  HIS  CALLING  PROGRAM  FOR  THE  ARRAYS 
IN  THE  CALL  LIST  •  Y(NEON)  ,  UORK(3««*NEON)  ,  IU0RK(S>  , 

..  DECLARE  F  IN  AN  EXTERNAL  STATEMENT,  SUPPLY  SUBROUTINE  F(T,Y,YP)  AND 

DOUBLE  PRECISION  YVI500},  UDRX(3500} 

INTEGER  lUORKCS) 

EXTERNAL  THE  DERIVATIVE  ROUTINE  CALLED  BY  RKF4S 
EXTERNAL  FCN 

..  ARRAY  FOR  THE  TITLE  (FIRST  LINE  OF  DATA),  CHARACTERS  END  OF  RUNS 
CHARACTER  TITLE(20)*4,  ENDRUN(3}*4 

I!  OEFIIK  TNE  CHARACTERS  END  OF  RUNS 
DATA  ENDRUN/'END  ','OF  R'.'UNS  '/ 

DEFINE  THE  INPUT/OUTPUT  UNIT  NUMBERS 
NI>5 


...  OPEN  INPUT  AND  OUTPUT  FILES 
OPEN(NI , FILE-'CVDATA.DAT' ) 

OPENdW,  F I  LEX  CVOPUT .  TXT ' ,  BLOCKS  I  2Es2048) 

!!  INITIALIZE  TNE  RUN  COUNTER 
N0RUN«0 

.’.  BEGIN  A  RUN 
N0RUN>N0RUIK1 

!.  INITIALIZE  THE  RUN  TERMINATION  VARIABLE 
NSTOP-0 

..  READ  THE  FIRST  LINE  OF  DATA 

REA0(NI,1000,END*999)  (TITLE(I),  I  «  I,  20) 
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c... 

C...  TEST  FOR  END  OF  RUNS  IN  THE  DATA 
C... 

DO  2  I  >  1,  3 

IF(TITLE<I)  .NE.  ENORUN(I)}  GO  TO  3 

2  CONTINUE 
C... 

C...  AN  END  OF  RUNS  HAS  BEEN  READ,  SO  TERMINATE  EXECUTION 

999  STOP 

C... 

C...  READ  TNE  SECOND  LINE  OF  DATA 
C... 

3  REA0(NI.*,EN0-999)  TO,  TF,  TP 
C... 

C...  READ  THE  THIRD  LINE  OF  DATA 
C... 

READ(NI,*,END>999)  NEON,  ERROR 

C... 

C...  PRINT  A  DATA  SUMMARY 

URITE(NO,10Q3)NORUN,(TITLE(I),  I  >  1,  20). 

1  TO.  TF.  TP. 

2  NEON.  ERROR 
WITE(*,10a3)  NORUN,  (TITLECI),  I  >  1,  20), 

1  TO,  TF,  TP. 

2  NECM,  ERROR 

C... 

C...  INITIALIZE  TINE 
T  «  TO 

C... 

C...  SET  TMI  INITIAL  CONDITIONS 
CALL  INITAL 

C..> 

C.y.  SET  THE  INITIAL  DERIVATIVES  (FOR  POSSIBLE  PRINTING) 

CALL  DERV 

C,  •  • 

C...  PRINT  THE  INITIAL  CONDITIONS 
CALL  PRINT(NI,  NO) 

C... 

C...  SET  TNE  INITIAL  CONDITIONS  FOR  SUBROUTINE  RKF45 
TV  ■  TO 

DO  5  I  -  1,  NEON 
YV(I)  -  Yd) 

5  CONTINUE 
C... 

C...  SET  THE  PARAMETERS  FOR  SUBROUTINE  RKF45 
C... 

C...  FIRST  CALL  TO  RKF45 
C... 

RELERR  >  ERROR 
ABSERR  >  ERROR 
IFLAG  >  1 
TOUT  -  TO  ♦  TP 

C... 

C...  CALL  SUBROUTINE  RKF4S  TO  START  THE  SOLUTION  FROM  THE  INITIAL 
C...  CONDITION  (IFLAG  -  1)  OR  COMPUTE  THE  SOLUTION  TO  THE  NEXT  PRINT 
C...  POINT  (IFLAG  «  2) 

C... 

4  CALL  RKF45(FCN,NEaN,YV,TV,T0UT,RELERR,ABSERR.IFLAG,W0RK,IU0RK) 
C... 

C...  PRINT  THE  SOLUTION  AT  THE  NEXT  PRINT  POINT 
C...  ■ 

T«TV 

TOUT  •  TV  ♦  TP 
PRINT  *,"TI«N  »  T 
DO  6  1  >  1,  NEON 
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Y(l>  -  YVCI) 

6  CONTINUE 
CALL  DERV 
CALL  PNINT(HI.NO) 

C<  •  • 

C...  TEST  FOR  AN  ERROR  CONDITION 
IFdFLAG  .NE.  2)  THEN 

C... 

C...  PRINT  A  NESSAGE  INDICATING  AN  ERROR  CONDITION 
URITE(NO,1004)  I  FLAG 

C... 

C. . .  GO  ON  TO  THE  NEXT  RUN 
GO  TO  1 
END  IF 

C... 

C...  CHECK  FOR  A  RUN  TERMINATION 
IFCNSTOP  .NE.  0)  GO  TO  1 

C... 

C...  CHECK  FOR  THE  END  OF  THE  RUN 
C... 

IF(TV  .LT.  (TF  •  O.SOO*TP))  GO  TO  4 

C... 

C...  THE  CURRENT  RUN  IS  COMPLETE,  SO  GO  ON  TO  THE  NEXT  RUN 
GO  TO  1 

C... 


•  • 

C...  FORMATS 
C... 

1000  F0RMAT(2QA4} 

1001  FORMAT(3E10.0) 

1002  FORNAT(15,20K,E10.0> 

100S  FORMATdHI, 

1  '  RUM  NO.  •  ',I3,2X,20A4.//, 

2  '  INITIAL  T  -  ',E10.3,//. 

3  '  FINAL  T  -  »,E10.3,//, 

4  '  PRINT  T  -  *,E10.3,//, 

5  '  NUMBER  OF  DIFFERENTIAL  EQUATIONS  •  ',15,//, 

6  '  MAXIMUM  INTEGRATION  ERROR  •  ',E10.3,//, 

7  1H1) 

1004  FORMATdN  ,//,'  IFLAG  »  ',13,//, 

1  '  INDICATING  AN  INTEGRATION  ERROR,  SO  THE  OHtRENT  RUN'  ,/, 

2  '  IS  TERMINATED.  PLEASE  REFER  TO  THE  DOCUMENTATION  FOR'  ,/, 

3  '  SUBROUTINE', //,25X,'RKF45',//, 

4  '  FOR  AN  EXPLANATION  OF  THESE  ERROR  INDICATORS'  ) 

END 

SUBROUTINE  FCN(TV,YV,YOOT) 

C... 

C...  SUBROUTINE  FCN  IS  AN  INTERFACE  ROUTINE  BETWEEN  SUBROUTINES  RKF45 

C...  AND  DERV 

C... 

C...  NOTE  THAT  THE  SITE  OF  ARRAYS  Y  AND  F  IN  THE  FOLLOUING  CCMHON  AREA 
C...  IS  ACTUALLY  SET  BY  THE  CORRESPONDING  COMMON  STATEMENT  IN  MAIN 
C...  PROGRAM  HEADHIT 

IMPLICIT  DOUBLE  PRECISION  <A*H),  DOUBLE  PRECISION  (O-Z) 

INTEGER  NEON,  NSTOP,  NORUN 

COMMON/T/  T,  NSTOP,  NORUN 

1  n/  Y<500) 

2  /F/  F<500) 

C... 

C...  THE  NUMBER  OF  DIFFERENTIAL  EQUATIONS  IS  AVAILABLE  THROUGH  COMMON 
C...  /N/ 

C... 

COMMON/N/  NEON 

C... 
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C...  AISOLUTE  DIMENSION  THE  DEPENDENT  VARIABLE,  DERIVATIVE  VECTORS 
DOUBU  PRECISION  TViSOO),  YDOT(500> 

TRANSFER  TNE  INDEPENDENT  VARIABLE,  DEPENDENT  VARIABLE  VECTOR 
...  FOR  USE  IN  SUBROUTINE  DERV 

T  ■  TV 

DO  1  I  ■  1,  NEON 
Yd)  ■  YVd) 

CONTINUE 

!!!  EVALUATE  THE  DERIVATIVE  VECTOR 
CALL  DERV 

!!!  TRANSFER  THE  DERIVATIVE  VECTOR  FOR  USE  BY  SUBROUTINE  RICF4S 

DO  2  I  «  1,  NEON 
YDOT(I)  -  F(I) 

2  CONTINUE 
RETURN 
EIS 
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DECK  CVSUBS.FOR  •  SUBROUTINES  REQUIRED  TO  IMPLEMENT  A  DYNAMIC  MODEL  OF  THE 
HUMAN 


CMOiaVASCUUR  SYSTEM 
UST  REVISION:  1/22/94 
SUIROUTIIK  INITIAL 

TNE  aodtl  dMcrIbad  htrtln  parallels  <he  development  presented  fn  a  paper  by 
Uhite,  RJ,  Croston,  RC  and  Fitzjerrell,  OG.  Cardiovascular  Modelling:  Simulating 
tha  Nusan  Cardiovascular  Responsa  to  Exercise,  Lower  Body  Negative  Pressure,  Zero 
Gravity  and  Clinical  Conditions.  Adv.  Cardiovasc.  Phys.  (Part  I),  pp.  195-229  (Kargar, 
Basal  1983).  It  also  draws  frost  papers  by  Jaron,  et  al  who  took  a  similar  approach 
In  particular  many  of  tha  parameter  values  for  the  physical  properties  of  the  segments 
were  taken  from: 

Jaron,  0,  Moors,  TV,  and  Bai,  J.  Cardiovascular  Response  to  Acceleration  Stress: 
A  Coaler  Simulation.  Proceedings  of  the  IEEE.  Vol  76,  No  6,  pp.  700-707  (1988). 

However,  some  of  the  parameters  listed  in  Jaron  were  clearly  in  error.  Where  new 
parameters  were  required  they  were  derived  to  yield  generally  acceptable 
flow/prassure/voluss  and  compliance  characteristics  of  the  various 
cardiovascular  subdivisions.  In  particular,  data  from 

Burton,  Alan,  C.  Physiology  and  Biophysics  of  the  Circulation.  Tear 
Book  Medical  Publishers,  Inc.  Chicago,  IL  (1965) 

and, 

fiuyton,  A.C.  Textbook  of  Medical  Physiology.  7th  Ed., 

W.B.  Saunders,  Philadelphia,  PA.  (1985). 

Tha  sndel  describes  the  spatial  and  temporal  variation  in  the  mean 
blood  praaaure  along  the  z-axia  of  tha  body.  The  model  neglects  the 
non-linaar  and  convective  terms  in  the  Nsvier-stokes  Equation.  The 
model  also  assumms  nagligibla  radial  flow.  The  flow  is  sttussd  laminar 
except  in  the  ascending  an  descending  aorta  where  fluid  flow  resis¬ 
tance  multiplied  by  33  to  account  for  turbulent  pressure  losses. 


NOTE:  TNE  SUBSCRIPT  NOTATION  INDICATES  PARTIAL  DERIVATIVE  URT  THE 
SUBSCRIPT  E.G.  Xt  >»  THE  FIRST  PARTIAL  OF  X  URT  TINE 
IN  THIS  MODEL: 


t  «  Time 

r  >  Radius  of  vascular  segment 
I  *  Length  of  vascular  segment 
rhoO  >  density  of  blood 
muO  3  viscosity  of  blood 


(sec) 

(m) 

M 

(kg/n^3] 

rN-sec/«r2J 


MODEL  FOR  ARTERIAL  SEGMENTS 

Tha  following  set  of  simultaneous  equations  are  solved  f  sch 
arterial  vascular  segment. 


Ptlt)  ■  1/C*(Oin(t)  -  Oout(t))  ♦  R2*(Qtin  -Qtcut) 
Ot(t)  «  1/L*(Pln(t)  -  Pout(t)  ♦  PGz  -  R*Q(t)) 
rt(t)  «  1/(2*Pi*r*l)*(0in(t)  -  Oout(t)) 


P  >  The  pressure  in  the  segment  [Pa] 

0  >  The  segmental  voluse  flow  [eTS/sec] 

C  ■  The  capacitance  of  the  segment  [m^S/Pa] 
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L  *  Th«  inartanc*  of  tho  njint 

Ra  ■  Tha  viacoua  flow  ratiatanca  In  tha  tagaant 

P6z  ■  Tha  hydroatatic  praaaura  diffaranea 

acroaa  tha  aigaant  bacauaa  of  gravity 


tka/«*4]  or  [Pa*Bac^2/a*3] 
W). 


tPal 


And,  tha  fel  lowing  afiproxiaatlona  for  Ra,  La,  and  Ca  are  taken  from 
a  papar  by 

Rfdaout,  at  al.  Olffaranca-Olffarantlal  Equatlona  for  Fluid 
Flow  In  Dfatenatbla  Titea.  IEEE  Tranaactlona  on  Blo*Nadlcal 
Englnaarlng.  Vol  RME-U,  MO.  3,  pp  171-177.  Jul  1967. 

Ra  ■  81*«j0*l/{8*pl*r^*) 

La  ■  9*rhoO*r2/l4*VOL) 

Ca  •  3*r*V0L*l/<2*E*h) 

Whara, 

E  ■  Vouig'a  aodulua  for  vaaaal  wall  [Pa] 

h  >  Vaaaal  Wall  thicknaaa  [ml. 

Finally, 

P6z  *  rhoO*(ix*gO*l*coa(thata). 

Whara, 

Gt  «  Tha  z-axia  "G-laval"  In  unita  of  earth's  gravity  [unitlaas] 

gO  «  Tha  aarth'a  gravitational  accalaration  [■/aac‘*'21 

thata  m  Tha  angla  batuaan  tha  aagaent  and  tha  z-axis  [radlana]. 


MODEL  FOR  VENOUS  SEGMENTS 

Tha  Modal  for  vanoua  aagMinta  uaa  adapted  froM 

Snydar.  at  al.  Conputar  SfMulatlon  Studlaa  of 
Vanoua  Circulation.  IEEE  Trana  Bio-Mad  Engr  Vol  BME-16, 

NO.  4  pp  325-334.  Oct  1969. 

Tho  unatraaaad  Internal  voluae  of  a  vaacular  stgaent  in  assuHd  to  be 

V  ■  Pi*r''2*i  carsj. 

Whan  tho  contained  voluae,  v,  is  greater  than  V,  the  transaural 
praaaura  ia  aaauaed  to  be  related  to  the  contained  voluae  by, 

dPuall  ■  1/C*v. 

Where  C  ia  the  vaacular  conpliance  aa  defined  above.  For  v  <  V, 
dPuoll  ■  1/{20*C)*v. 

In  a  collapaad  or  partially  collapaad  vain  the  flow-pressure 
relationship  based  on  an  (aaauaad)  elliptical  cross-section 
and  is  given  by 

Ot  «  1/Lv*(Pin(t)  -  Pout(t)  ♦  PGz  -  Rv*0(t)) 

Whara, 

Lv  ■  9*rho0*l''2/(4*v),  and 

{  81*Mu0*pi*2*r4*r''2/(8*v*3)  for  v  <  V 
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Rv  ■  }  or 

j  81*««j0*l/<8*pi*r“4)  for  v  >  or  ■  V 
{  or  81*«j0*l*3/(8*v-2)  «. 


PERIPHERAL  CAPILLARY  BEOS. 

Poriphoral  rotistanco  and  capacitance 

are  Modelled  aa  luawd  paraMeter  aodela  ("T"  circuital 
folloMina  the  Method  of  Jaron,  at  al  (cited  above). 


Re  Rv 

Pa  o-/W\--|--/W\— o  Pv 

I 

Cperipharal 

-I- 

I 

Pextemal  (ie  P  G*auit) 
Pref  (AtMoepheric) 


PULNONARY  CIRCULATIOH 

The  pulMonary  circulation  ia  Modalled  ae  a  luMped 
paraMeter  mo^I  asain  follouing  Jaron'a  Method.  The 
Modal  ia  a  "PI"  circuit  aa  ahown  below. 


Prtvent  Rpul 

Qvr* - >1— A/V\ . I  Pleft  atriua 

venoua  j  j 

return  —  Cpul  j 


I  I 

Intra-Thoracic  Preaaurc 


CMOIAC  CIRCUUTION/OUTPUT 

The  chaabera  of  the  heart  are  Modelled  aa  variable  capocitancea 
aoparated  ty  ane*uay  valvea.  The  pulMonic  and  aortic  valvea  are 
alao  Modelled  aa  one-way  valvea.  The  peneral  Method  of  Model  I  ins 
The  heart  and  ita  circulation  followa  the  Method  of  Snyder  et  al. 
Output  flow  from  the  left  atriua  and  left  ventricle  are  modelled 
aa  aiapla  half-wave  rectified  ainuaoida  whoae  voluoe  flowa  are 
aatinated  froM  pulaonary  venoua  flow. 


PRESSURE  REFEREHCE 

The  preaawe  reference  for  the  model  ia  located  at  the  tri-cuapid 
valve  which  preaumably  tracka  intrathoracic  preaaure. 


MODEL  MECHANICS 

For  each  veaael  aagaont,  three  coupled  non-linear  differential 
aquationa  ouat  be  aolved  aimultaneoualy.  There  are  20  vaacular 
aesmenta  (the  pulaonary  circuit  ia  aegment  1).  There  are  10 
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M  s«9Mntt  aodtllad  m  slap^*  rMlctance  and  caaplf*nc« 
circuits  Mhleti  arc  affactsd  diractly  by  axtra-vaacular  praasure. 

Tba  praaauraa  and  ficus  in  tbs  various  saosants  arc  couplad  by 
tlMlr  apatf*^  connactlon.  The  foUoulnp  tabla  pivas  the 
afiproxliBSta  anatcailcal  location  and  the  corresponding  z-axis 
carinate  (awaaurad  froa  the  tricuspid  valve)  for  each  segawnt. 

The  z*ax1s  coordinates  uere  based  on  a  177  cai  tall  standing  nan. 


Sogaant 

Nudiar 

Anatoaical 

Location 

Arterial 

Origin 

Z-axis 

coordinate  (ca) 

Peripheral 

Bed 

1 

Nid-Pulaonary 

0 

X 

2 

Ascending  Aorta 

0 

5 

Oascanding  Aorta 

5 

4 

Thoracic  Aorta/Vana  Cava  -8 

X 

5 

Diaphraga/Louar  Ling 

-15 

6 

Ranal/Hepatic 

-22 

X 

7 

Splanchnic 

-32 

X 

8 

Buttocks 

-42 

X 

9 

Fsaoralis 

-50 

10 

Mid  Thigh 

-65 

X 

11 

Knae/Poplataal 

-  80 

12 

Calf 

-100 

X 

13 

Ankle 

-125 

14 

Foot 

-132 

X 

15 

Aortic  Arch 

6 

16 

Louer  Neck 

15 

17 

Carotid  Sinus 

25 

18 

Ophthalaic 

34 

X 

19 

Mid  Brain 

37 

20 

Cerebral 

42 

X 

Initial  Conditions  (t  •  0} 

The  initial  conditions  for  pressure,  flou,  pnd  voluae  are 
set  based  on  a  steady-state  solution  for  the  nodel  at  1  Gz 
for  a  supine  posture.  For  other  postures,  the  initial  theta's 
for  the  segaants  aust  be  changed. 

Postural  and/or  6z  changaa  during  a  siaulation. 

This  can  be  aost  easily  accoaplished  by  adding  time 
varying  profiles  for  Gz  and  the  theta's  in  SUMOUTINE  DERV 
Mhich  foras  the  derivatives  for  CVNOOEL. 

THE  HIMERICM.  NETNGO  OF  LINES  (U.E.  SCHIESSER)  IS  EMPLOYED  TO 
INTEGRATE  THE  COUPLED  DIFFERENTIAL  EQUATIONS  (DES). 

ODE  COMMON 

/Y/  tiae  variables 

/F/  tiaa  derivatives  of  variables 

/R/  A  /I/  real  and  integer  paraaaters  required  to  define  constants  and 
dafine  the  spatial  integration  grid. 

IMPLICIT  DOUBLE  PRECISION  (A-H,  0-Z) 

PARAMETER  (HEQ  >  20,  NPSEG  >  10) 

.INTEGER  N8T0P,  NORUN,  IP 

INTE0ER*2  ALIN,  ALOUT,  VLIN,  VLOUT,  PVS,  PIN,  POUT 
DOUBLE  PRECISION  NN2PA,  auO 

COMKM/T/  T,  NSTOP,  NQRUN  I  Rut  Parameters 
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...  Arrays  for  aagaantal  variablaa  Praasura  (p),  FIom(Q),  and  radH  (r) 


1 

nt  89(4). 

HQ(4). 

1  Heart's  Chaabers  RA«1 

• 

A9(86Q), 

A0(H6Q), 

Ar(860). 

1  Arterial  P,  Q,  r 

« 

V9(IK0), 

M(8EO). 

Vr(HE6), 

1  venous  P,  0.  r 

• 

V09(3). 

V0Q(3). 

1  Venous  flous  into  heart 

* 

99(HM). 

PO(86Q). 

1  Peripheral  P,  Qin,  Oout 

Tins  derivatives 

of  the  sagi 

santal  variables:  Pt,  Qt,  rt 

2 

/F/  H9t(4). 

HQt(4), 

1  Heart's  Chaabars  RAal 

* 

APt(860), 

A0t(8E0), 

Art(8E0). 

1  Arterial  Pt,  Ot,  rt 

• 

V9t(860). 

VOt(866). 

VrtlHEQ), 

1  Vanoua  Pt,  Qt,  rt 

• 

V09t(3). 

V0Qt(3), 

1  Venous  flous  into  heart 

• 

99t(H6Q), 

PQt(86Q), 

1  Peripheral  Pt,  QIHt,  QOUTt 

Par—tari  nacasaary  to  fora  tha  diffaranttal  aquaKona 


Pf  -  3.14159... 

gO  *  9.80665  (■/aae''2]  aarth's  acealaratlon  of  gravity 

rti^  *  1050.  [kg/ai*3]  danaity  of  ahota  blood  (45%  Hct)  {  Aasuaod 

■uO  •  2.7  CebI  vlacoaity  of  ahola  blood  (4SX  Nct)|  Constant 

D2R  -  p1/iao  [radlana/dagraa]  seala  factor 


3  /t/ 


4  /!/ 


PI.  gO.  rhoO.  auO,  028,  NN2PA,  82. 
2A0(W0).  247(860).  2V0(8EQ},  2VT(8EO). 
TH6TA(8E0).  IICAP(4),  HV0L(4).  HV8(4). 
410(860),  ArU(860).  46(860),  Ah(860). 
ACAP(860),  4868(860),  418687(860), 
VL0(86O),  Vr0(8e0).  VrU(860), 


I  Constanta 
I  Arterial  4  Vanoua 
I  Orientation  angle 
I  Arterial  I,  r,  6,  h 
I  Arterial  Capacitance,  resistance 
I  Venous  I,  r,  rlMS7RESS60 


VCAPO(aeo),  vcAPloeO),  VOCSIUCO),  vimerkocQ),  i  vanoua  Capacitance,  rasistanee,  inertance 

P8A(880),  P8V(860),  PCAP(860),  I  Peripbaral  8a,  Rv,  C 

PI8687(l»l),  pvai(860).  I  Peripbaral  I,  V 

940(860),  PV0(860).  I  Initial  P  conditions 

040(860),  OV0(86O),  I  Initial  0  conditions 

AVOLdCO),  VVa.(860),  I  A  4  V  Voluaas 

96X7(860),  I  Externally  applisd  Pressure 


70,  687487,  6N4X,  788X1,  7gRK2,  TNAX,  6718, 


6Z.  4096(860),  V09G(8EQ)  I 
19,  80X968(89866).  I 
AL18(860).  AUXI7(860).  I 
VL18(860),  Vl.aU7(8E0),  I 
918(860),  P0U7(8E0),  I 
9V8(8EO).  I 
IF0OTSE6,  18640866,  IHEAR7SE6  I 


I  6*Profila  paraavtera 
6z  4  Delta  P  froai  6 
Peripheral  Bad  Indexes 
Linkage  Data  arterial 
Venous 
Peripheral 

8udbar  parallel  venous  aegwnta 
Foot,  Head,  4  Heart  seg  nuas 


8ota  that  artery  output  flow  feeds  artery  input  or  peripheral  bed 
input,  artery  input  coaaa  only  fron  arteries  or  the  heart,  venous 
output  floHS  to  veins  or  tha  heart,  venous  input  cones  fron  veins 
and7or  peripheral  bads,  peripheral  bods  are  fed  only  by  arteries,  and 
feed  only  veins,  the  index  (i)  for  an  segnant  refers  to  its  input 
flow  and  pressure.  The  output  pressure  for  a  segnant  is 
stored  in  P(i^1)  and  its  output  flou  is  stored  at  0(i4'1) 


Define  Sons  Constants  and  Paraneters 

Heart  valve  resistances 

DATA  HVR/  1.48D«6.  1.460»6,  2.96(»6,  2.96a»6/ 

Heart  chaafaer  capacitances 

DATA  HCAP/  2.250-7,  6.550-7.  1.120-7,  3.280-7/ 
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...  Arterial  Sagamt  length  Dntare] 


OATA  ALO/  3.0*2, 

3.0*2, 

5.0*2, 

7.0*2, 

5.0*2, 

• 

12.0*2, 

10.0*2, 

8.0*2, 

15.0*2, 

20.0*2, 

• 

15.0*2, 

25.0*2, 

5.0*2, 

2.0*2, 

9.0*2, 

• 

10.0*2, 

9.0*2, 

3.0*2, 

4.0*2, 

1.0*2/ 

...  Arterial  Tigaint  radii  at  t  ■  0  Oaetarc] 

...  Ttiaaa  radii  are  bated  on  flow  raaittanca 

DATA  Artl  /6.00D-3,  1.500*2.  1.00D-2,  1.200*2.  1.000*2. 

•  «.000*3.  5.500*3.  4.000*3.  3.500*3.  4.000*3, 

•  2.800*3.  4.500*3,  2.750*3.  1.000*3.  6.000-3, 

•  3.000*3,  3.000*3,  3.000*3,  3.000*3,  1.500*3/ 

...  Tliaaa  radii  are  baaed  on  capacitance  and  raaittanca 
...  Voung'a  aedulua  for  arterial  aagaant  walla  CPal 


OATA  AE  /  2.50^, 

5.00*5, 

5.00*5, 

7.00*5, 

7.00*5, 

*  8.00*5, 

8.00*5, 

8.00*5, 

8.00*5, 

1.00*6, 

*  1.00*6, 

1.00*6, 

1.00*6, 

1.00*6, 

8.00*5, 

*  8.00*5, 

8.00*5, 

8.00*5, 

8.00*5, 

8.00*5/ 

...  Wall  thickneaa  for  arterial  lagtnta  Cmtara} 


OATA  Ah  / 

2.0*4, 

16.0*4, 

16.0*4, 

14.0*4, 

12.0*4, 

• 

12.0*4, 

10.0*4, 

10.0*4, 

8.0*4, 

8.0-4, 

• 

8.0*4, 

6.0*4, 

6.0*4, 

5.0*4, 

5.0-4, 

• 

6.0*4, 

6.0*4, 

6.0*4, 

5.0*4, 

5.0-4/ 

a  a  a 

...  Niflbar  of  parallel  vanoue  pattia  in  each  aagaant 

OATA  W/  4,  1,  1,  2,  4,  4,  4,  4,  2,  2, 

•  2,  2,  4.  4,  2.  2.  4,  4,  4,  4/ 

a  a  a 

...  ¥anoue  aagaant  length  Owtara] 

OATA  VLO/  10.0*2,  2.0*2,  2.0*2,  10.0*2,  20.0-2, 

•  50.0*2,  40.0*2,  32.0*2,  30.0*2,  40.0*2, 

•  30.0*2,  40.0*2,  20.0*2,  8.0*2,  27.0-2, 

•  20.0*2,  36.0*2,  12.0*2,  16.0*2,  4.0*2/ 

a  a  • 

...  Initial  radii  for  Vanoue  aagaant  Owtert] 


OATA  VrU/  5.00*3, 

5.00*3, 

5.00*3, 

3.00*3, 

3.50*3, 

• 

2.50*3, 

4.00*3, 

4.00*3, 

3.00*3, 

3.00*3, 

* 

3.50*3, 

3.30*3, 

2.50-3, 

1.80*3, 

4.50*3, 

* 

4.00*3, 

4.00*3, 

3.30*3, 

3.00*3, 

2.00*3/ 

...  Vanoue  capacitance  Ca'3/Pa] 


OATA  VCAPO/  5.00*8, 

5.000-8, 

1.000*8, 

5.000*8, 

5.00-8, 

• 

5.00*8, 

5.000*8, 

4.000*8, 

3.000*8, 

2.50*8, 

* 

8.00*8, 

5.000*8, 

5.000*8, 

5.000*9, 

2.00-8, 

* 

5.00*8, 

8.000-8, 

1.000*8, 

1.000*8, 

3.00-8/ 

...  Pariptwral  fagaant  Indicea  (Thera  are  10  poripharal  aagaanta). 
OATA  gOXPER  /  1,  3,  6,  7,  8,  10,  12,  14,  18,  20/ 

a  a  a 

...  Paripharal  Vaacular  Capacitance  DB*3/Pa] 

OATA  PCAP/  1.130-7,  0.00000,  3.750-8,  0.0000,  0.00000, 
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7.500-8, 

1.130-7, 

7.500-8, 

0.0000,  3.750-8, 

* 

0.00000, 

3.750-8, 

0.00000, 

3.750-8,  O.MOOO, 

* 

0.00000, 

0.00000, 

3.750-8, 

O.OOOM,  3.750-8/ 

...  Parlpiwral  Vascular  lasistanca  Arterial  side  tPa*sec/«'31 
...  Assign  9.9099  to  segaants  with  no  peripheral  bod. 


DATA  PRA/  1.20IH7.  9.99099.  I.AIO^,  9.99099,  9.99099, 

•  1.390f9.  3.M048,  1.37D+9,  9.99099.  1.3A0^9, 

•  9.99099,  Z.iao^,  9.99099,  6.3iD*9,  9.99099, 

•  9.99099.  9.99099,  1.320^10,  9.99099,  6.670^/ 

...  Peripheral  Vascular  Resistance  Venous  side  tPa>sec/«^3] 

...  Assign  9.9099  to  asgwnts  with  no  peripheral  bed. 


OATA  PRV/  1.33(K6.  9.99099,  I.SdO^,  9.99099.  9.99099, 

•  1.54(K6.  3.830^7,  1.520^,  9.99099,  1.49IH8, 

•  9.99099,  2.43(K8.  9.99099,  7.040«8,  9.99099, 

•  9.99099,  9.99099,  1.4d0«9.  9.99099,  7.420*7/ 


Initialize  extn 


'sl  pressure  vector 


OATA  PENT/  0.00*2,  0.00*2, 

0.00*2, 

0.00*2, 

0.00*2, 

*  0.00*2,  0.00*2, 

0.00*2, 

0.00*2, 

0.00*2, 

•  0.00*2,  0.00*2, 

0.00*2, 

0.00*2, 

0.00*2, 

•  0.00*2,  0.00*2, 

0.00*0, 

0.00*0, 

0.00*0/ 

Set  initial  flow  Di/'3/sec] 

Arterial  flow 

MTA 

AO/ 

8.970-5, 

9.000-5, 

9.000-5, 

6.500-5, 

6.500-5, 

• 

6.500-5, 

5.670-5, 

2.330-5, 

1.500-5, 

1.500-5, 

• 

6.670-6, 

6.670-6, 

1.670-6, 

1.670-6, 

1.670-6, 

• 

1.670-5, 

1.670-5, 

1.670-5, 

1.580-5, 

1.580-5/ 

Vanous 

flew 

DATA 

VQ/ 

9.000-5, 

2.000-5, 

7.500-5, 

7.000-5, 

7.000-5, 

• 

6.500-5, 

6.500-5, 

2.330-5, 

1.000-5, 

1.100-5, 

« 

4.700-6, 

7.500-6, 

4.500-6, 

1.670-6, 

1.670-5, 

« 

1.670-5, 

1.670-5, 

1.670-5, 

1.580-5, 

1.580-5/ 

Venous  output  flous  into  heart 


DATA  VOO/  9.00-5,  1.70-5,  7.30-5/ 


Peripheral  flow 


DATA  PQ  / 

8.970-5, 

0.00000, 

8.330-6, 

O.OQDOO, 

0.00000, 

• 

8.330-6, 

3.330-5, 

8.330-6, 

O.OQDOO, 

8.330-6, 

* 

0.00000, 

5.000-6, 

0.00000, 

1.670-6, 

0.00000, 

• 

0.00000, 

0.00000, 

8.330-7, 

0.00000, 

1.580-5/ 

;...  Initial  Heart  flow 

OATA  HQ  / 

8.970-5, 

8.970-5, 

8.970-5, 

8.970-5/ 

C. . . 

C...  The  following  arrays  code  the  linkage  between  vascular  segwents 
C...  Each  segwnt  link  elamnt  contains  the  index  of  the  next  segment 
C...  In  the  cardiovascular  tree,  for  exsaple,  ALIN<3)  »  4,  which 
C...  Mans  arterial  segwnt  3  feeds  arterial  segwnt  4.  Segwnt  -1  codes 
C...  for  tsruinal  psripheral  beds  for  arteries  and  for  the  heart  for  veins. 
C... 

C...  SEGMENT  A1  A2  A3  A4  A5  A6  A7  A8  A9  A10  All  A12  A13  A14 
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c... 

DATA  ALIMZ-I,  S,  4,  5,  6.  7,  6,  9,10,  11,  12,  IS,  14,  -1, 

!!!  SCfiMOIT  A1S  A16  A17  A18  A19  A20 
16,  17,  18,  19.  20,  -1/ 

•  • 

..  VmouB  Unkao* 

!!  K6NENT  VI  V2  VS  V4  VS  V6  V7  V8  V9  V10  VII  V12  VIS  V14 

MTA  VIIN/-1,  -1,  -1,  S,  4,  5,  6.  7.  8,  9,  10,  11,  12,  IS, 

!!  ttONENT  VIS  V16  V17  V18  V19  V20 

P20 

•  2.  15.  16.  17.  18.  19/ 

•  • 

..  Parlpharal  SasMnt  Lfnkaga,  PIN  apaeiflM  tha  input  tourca  for  tha 
..  saowit  uhlch  ia  only  froa  artariat,  POUT  tpacifiaa  tha  output  aagaant 
..  Hhtch  ia  only  to  voina.  "0"  want  thara  it  no  paripharal  tagnant  for  tha 
..  tagaant  maOar.  Mota  that  tha  prataura  at  tha  inlat  of  tha  paripharal 
..  aagwnt  ia  at  AP(PIN<i)  ♦  1) 

SfOMENT  PI  P2  PS  P4  PS  P6  P7  P8  P9  P10  P11  P12  PIS  P14 

DATA  PIN  /  0.  0,  S,  0.  0.  6.  7,  8.  0,  10,  0.  12.  0,  0, 

!!  SEGMENT  PIS  P16  P17  P18  P19  P20 

’*  *  0,  0,  0,  18,  0,  0/ 

!.  SEGMENT  PI  P2  PS  P4  PS  P6  P7  P8  P9  P10  P11  P12  PIS  P14 

OATA  POUT/  1,  0.  3.  0,  0,  6,  7,  8,  0.  10.  0.  12,  0,  0, 

!!  SEGMENT  PIS  P16  P17  P18  P19  P20 

**  *  0,  0,  0,  18,  0,  0/ 

a  a 

Z'axia  poaitiona  ralativa  to  tricuapid  valva  for 
ttia  origin  of  tha  artarial  aagaant  (M 

OATA  2AO/  0.000,  0.000,  5.0*2,  0.0*2,  *15.0*2, 

•  -20.0*2,  *32.0*2,  **’.0*2,  *50.0*2,  *65.0*2, 

•  -85.0*2,*100.0*2,*125.0*2.*130.0*2,  5.0*2, 

•  15.0-2,  25.0-2,  34.0*2,  37.0*2,  41.0*2/ 

...  Z-axia  poaitiona  ralativa  to  tricuapid  valva  for 
...  tha  tanaination  of  tha  artarial  aagwnt  Cal. 

OATA  ZAT/  3.0*2,  3.00-2,  0.000,  *15.0*2,  *20.0*2, 

•  *32.0*2,  *42.0*2,  *50.0*2,  *«.0*2,  *85.0*2, 

•  -100.0-2,*125.0-2,*130.0*2,*132.0*2,  15.0*2, 

•  25.0*2,  34.0-2,  37.0*2,  41.0*2,  42.0*2/ 

ooo 

...  Z*axia  pwitiona  ralativa  to  tricuapid  valva  for 
...  tha  origin  of  tha  vanuua  aagaant  (U. 

OATA  ZVO/  3.00*2,1.50*2,  *1.50*2,  -15.0*2,  *20.0*2, 

•  *32.0*2,  *42.0*2,  *50.0*2,  *65.0*2,  *85.0*2. 

•  *100.0*2.*125.0*2.*130.0*2,*132.0*2,  15.0*2, 

•  25.0*2,  34.0*2,  37.0*2,  41.0*2,  42.0*2/ 

•  a  a 

...  Z-axia  poaitiona  ralativa  to  tricuapid  valva  for 
...  tha  tanaination  of  tha  vanoua  aagwnt  Cn]. 


uuuu  uuu  uuuuuuuuuuu  uuu 


Proorwn  CVSUBS.FOR 


c... 

DATA  ZVT/  O.OM.  O.ODOO.  O.ODOO.  -I.SO-a.  •^S.D^2, 

•  -20.D-2.  -32.0-2.  -42.0-2,  -50.0-2,  -A5.D-2, 

«  -85.0-2,-100.0-2.-125.0-2.-130.0-2,  1.50-2, 

•  15.0-2,  25.0-2,  34.0-2,  37.0-2.  41.0-2/ 

■  •  • 

...  Initial  orlantationa  (dagraaa)  of  x-axfa  projaction  of  vascular 
...  sagaNnts.  Artarial  and  vanoua  aisiwsrt  to  bo  at  tha  sas»  orientation. 

DATA  THETA/  20.00,  20.00,  20.00,  20.00,  M.DO,  i  Partially  raclinod 

•  20.00,  20.00,  20.00,  90.00,  90.00,  I  Saatad  poaition 

•  90.00,  110.00,  110.00.  90.00,  20.00.  I  20  dag  SSA 

•  0.00,  0.00,  0.00,  0.00,  0.00/ 


Oafine 

soaa  physical  constants 

Pi 

>  OACOS(-l.aOO) 

!  pi 

gO 

-  9.8066500 

1  a^sac*2  -  earth's  gravity 

rhoO 

>  1050.000 

1  1^01*3  -  density  of  whole  blood 

muO 

•  2.7DD-3 

1  H-sac/aif*2  -  fluid  viscosity 

02R 

-  pi/iao.oo 

1  scale  fro*  degrees  to  radians 

IM2PA 

a  1.0132505/760.00 

1  scale  froa  HMlg  to  Pascals 

fix 

«  4.00 

1  Initial  Gx 

R2 

■  0.00200 

1  Jaron's  wall  energy  tern 

II  INITIAL  OOHOITIOMS  (T  «  0) 

a  a 

..  Tha  praaauraa  ara  sat  aaausing  a  prana  poatura  ia  transvarsa  gO. 

..  Tha  initial  prasauras  ara  aaaignad  by  linaarly  intarpolating 
..  praaauraa  fron  tha  foot  to  tha  haart  and  fron  tha  haart  to  tha 
..  carabral  aagaant.  Tha  saan  artarial  praaaura  ia  assused 
. .  to  ba  100  oaNg  at  tha  haart  and  95  sa  Hg  at  both  tha  foot  and 
..  earobral  aagwnta.  Tha  vanoua  praaaura  is  assusad  to  ba  2  awg 
..  at  tha  haart  and  5  asHg  at  both  tha  foot  and  carabral  sogasnts. 

MPOOT  •  95.D0*MN2PA 
Pimm  •  95.00*IM2PA 
IPOOrSCO  •  14 
INEA0IE8  •  20 
INEARTSEG  ■  1 

PNATRN  •  PEXTCD  I  Right  Atrial  Praaaura 

HP(1)  •  PRATRN  *  MN2PA  I  Inlat  Prassura  to  Right  Atriui 

H0P1  •  2.D0*NN2PA  I  Incrassa  in  right  atrial  pressure 

PRVENT  >  NP(1)  *  N0P1  !  Inlet  Pressure  to  Right  Ventricular 

NP<2)  -  PRVENT 

mn  •  11.00*MN2PA  I  Incrassa  in  right  ventricular  prassura 
PUTRN  ■  4.00*I«2PA  I  Left  Atrial  Prassura 
NP(3)  ■  PLATRN  i  Left  Atrial  Inlet  Pressure 

HOPS  «  4.00*fM2PA  I 

PLVENT  ■  HP(3)  '*  N0P3  I  Left  Ventricular  Pressure 

HP(4)  >  PLVENT  I  Inlet  Pressure  to  LV 

>  92.00*NN2PA  I  Increase  in  LV  Pressure 

a  a  a 

...  6-Profila  parasMters 

TO  ■  0.00 
eSTART  ■  1.00 
GNAX  «  3.00 
THAN  •  400.00 
TRRK1  ■  10.00 
TIRK2  «  300.00 
6PIN  >  3.00 
i  ■  1 

DO  IMILE  (I  .LE.  NEQ) 

TNETAfi)  •  THETA! i}*02R 
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1  ■  t  ♦  1 

END  DO 
i  ■  1 

DO  WHILE  (I  .LE.  NEO) 

SCM.EF  ■  1.00 

IF(  <  .LE.  5  .OR.  {  .EO.  15  )  SCALEF  >  33.00 
MESd)  ■  81.00n»j0*AL0<l)/<8.00^1*ArO<i>**4>*SCALEF 
OPVS  >  MU(PVS(<)) 

Vrd)  ■  DNAXKVrd),  1.3300*VrUd)) 

VRESd)  ■  81.00*«A)*CVLO(t)/OWS)/(8.00*R1*Vr<1)**4) 

I  ■  1  ♦  1 
EHO  00 

AD(1)  ■  HP(2)  *■  HOPE  *  2.00*NN2PA 
AP(2)  ■  HP(4)  *  H0P4  ♦  2.00*(W2PA 
I  -  3 

00  WHILE  (  <  .LE.  IFQOTSEG) 

AP(i)  >  AP(i-l)  •  A0(i-1}*ARESd-1} 

•  ■»  rhoO^Z*gO*(ZAO(n-2AT(0)*OCOS(THEtA(i)) 

I  ■  I  ♦  1 

EHO  OO 

API 15}  >  AP(3) 

<  «  16 

OO  WHILE  (  1  .LE.  IHEAOSEG) 

AP(1)  ■  APd'l)  -  A0(1-1)«ARES<i-1) 

•  ♦  rtio0^>*80*(ZA0({)-2AT(I))*0COS(THETA(i)) 

I  ■  I  ♦  1 

EHO  00 

...  S«t  th«  Initial  radii  and  artarial  capacitance 


i  «  1 

00  WHILE  (i  .LE.  HEO) 
dPHalt  ■  AP(i) 

daltaR  •  7.S0-1»dPMaU*ArU<i)«*2/<AE(i)*Ah<i» 

Ar(I)  -  ArUd)  «  daltaR 

ACAPd)  ■  3.IHWi*Ard)*^*AL0d)/{2.00*AEd)*Ahd)) 
daltaR  >  dPMall*ACAPd)/<2.00^i*Ard)*AL0d» 

Ard)  -  Arud)  >  daltaR 
AVOLd)  •  Pi*Ard)**2*AL0d) 
i  «  {  ♦  1 
EHO  00 

a  a  a 

...  Initial  Vanoua  Preaauras 

¥0P<2)  ■  MPd) 

VOPIS)  >  HPd) 

WP(1>  ■  HP<3}  ♦  V0<1)*VRESd) 

*  -  rtMO^S*gO*(ZVOd)  '  ZVTd))*0C0S<THETA(1» 

VP(2)  -  yOP(2)  «  Va(2}*VRES<2) 

*  -  rhoO*6Z*gO*(ZVO(2)  -  2VT(2))«0C0S(THETA<2)) 

VP<3>  ■  V0P(3>  ♦  VQ<3)*VRES13) 

*  -  rl«oO^**gO*<2VO<3)  •  ZVT(3))*0C0S<THETA(3)) 

i  >  4 

00  WHILE  (  {  .LE.  IFOOTSEG) 

VPd)  ■  VP<i-1)  ♦  VOd)*VRESd} 

*  -  rho0*GZ*90*(ZVQd}  -  ZVTd))*OCOS(THETAd)) 
i  ■  i  ♦  1 

END  00 

VPd5}  -  VP(2)  ♦  VO<15)«VRESd5) 

*  -  rtioO*Gz*90*(ZVOd5)  -  2VTd5})»OCOS<THETAd5)) 
.  {  •  16 

00  WHILE  (  i  .LE.  IHEAOSEG) 

WPd)  •  WPd-1)  ♦  VQd)*VRESd) 

*  -  rfioO*Cz*gO*(ZVOd)  -  2VTCf))*OCOS(THETA(i)) 
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«  ■  1  ♦  1 
EM)  DO 

C... 

C...  Coaput*  th*  initial  raaiatancaa 

c... 

i  -  1 

DO  IMILE  (i  .LE.  NED) 

VCAD({)  >  VCAPO(i) 
dPwall  •>  VP(i)  •  PEXT(i} 

daltiE  *  dPwall*VQlP(i)/(2.00*Pi*VrU(i)*VL0(i)) 

Vr(i)  «  vrU(i)  *  daltaR 

dtltat  »  dPMall*VWP{i)/(2.00*Pi*Vr{i)*vt0{i)> 

Vr(l)  «  VrU(i)  *  daltaR 
VVOL(i)  ■  Pi*Vr(i)**2*^0(i) 
i  •  i  ♦  1 
EM)  DO 

C... 

C...  Initial  Haart  flowa 
C... 

m(1)  *  9.D-S 
HQ<2)  «  9.D-5 
m(3)  «  9.D-S 
m(4)  •  9.0-5 

C... 

C...  Sat  initial  Paripharal  Prasauraa 
C... 

PP<1)  •  PO(1)*PRA(1)  ♦  VO<1)*PRV(1)  ♦  VP(1) 
i  •  3 

DO  WHILE  (  !  .LE.  HEQ) 

IF<  PiH(i)  .ST.  0  )  THEH 
PP(i)  «  AP(i<»1) 

EHD  IF 
i  •  i  ♦  1 
EHD  DO 

PP<H)  ■  Pa<U)*PRA(U)  ♦  Va<U)*PRV(14)  ♦  VP(14) 

PP(20}  ■  Pa(20)*PRA<20}  *  VQ(20)*PRV(20)  ♦  VP(20) 

C.  . . 

C...  Call  OERV  to  sat  initial  darivatives  --  loop  to  stabilize  derivatives 
C... 

i  •  1 

DO  WHILE  ({  .LE.  100) 

CALL  DERV 
i  «  i  ♦  1 
EHD  DO 
IP«0 
RETURH 
EHD 

C... 

SUHROUTIHE  DERV 

C... 

C...  DERV  CALCULATES  THE  TINE  DERIVATIVES  TO  BE  INTEGRATED  BY  RKF4S 
C... 

C...  ODE  CQNNOH 
C... 

C...  /V/  tine  variables 

C...  /F/  tisie  derivatives  of  variables 

C...  /S/  spatial  derivatives  of  variables 

C...  /R/  A  /I/  resl  and  intagar  paraneters  required  to  define  constants  and 

C...  define  the  spatial  inteoration  grid. 

C.-.. 

INPLICIT  DOUBLE  PRECISIOH  (A-H,  0-Z) 

PARAMETER  (HEO  «  20,  NPSEG  *  10) 

INTEGER  HSTOP,  NORUN,  IP 
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IIITEa»*2  AtIM.  ALOUT,  VtlM,  VtOUT.  PVS.  PIM.  POUT 
OOUILE  PRECISIOM  MBPA,  MuO 

COMNON/T/  T,  NSTOP.  NORUN  I  Run  PatMMters 

Arrays  for  sagaantal  varfablaa  Prassura  (P).  FIoh(O),  and  radii  (r) 


C.. 

C.. 

C.. 


c... 

C*  •  • 

c... 


c... 

C...  ParasMtars  nacaasary  to  fora  tha  diffarantiat  aquations 
C... 

C...  Pi 
C...  gO 
C...  rhoO 
C...  wO 
C...  02R 

C... 

3 


1 

/Y/ 

!»(*>, 

HQ(A). 

I  Heart's  ChaaPers  RA^I 

* 

AP(NEQ), 

AO(MQ), 

Ar(NEQ), 

1  Arterial  P,  Q,  r 

• 

VPdKQ), 

VQ(NEQ), 

Vr(NEQ), 

1  Vanous  P,  Q,  r 

* 

V0P(3), 

V00(3), 

1  Vanous  flous  into  heart 

* 

PP(NEO). 

PQINEQ), 

1  Peripheral  P,  Din,  flout 

Ti 

Ina  1 

derivativas 

of  tha  sagmantal  variables:  Pt,  9t,  rt 

2 

/f/ 

HPt(A), 

HOtlA). 

(  Heart's  Chaabers  RA*! 

* 

APt(HEO.', 

AQt(HEQ). 

Art(NEQ), 

!  Arterial  Pt,  At,  rt 

* 

VPKNEO), 

VQt(NEO}. 

Vrt(NEQ}, 

1  Venous  Pt,  At.  rt 

• 

V0Pt(3), 

VOQt(3). 

1  Vanous  flows  into  heart 

* 

PPt(NEO). 

PQt(HGO), 

1  Peripheral  Pt,  fllNt,  flOUTt 

3.U1S9... 

9.80665  Cai/sac^2]  aarth't  accalaration  of  gravity 
1050.  Ckg/a^Sl  dansity  of  whola  blood  (ASX  Hot)  | 

2.7  (c|d  viscosity  of  uhola  blood  (ASX  Hct){  Constant 

pi/180  Cradians/dsgraa]  seals  factor 


/R/ 


PI.  gO.  rtioO,  auO,  D2R,  MI2PA,  R2.  I 
2AO(HEO>.  2AT(HE0).  ZVOfNEO).  ZVT(NEO).  I 
TNETA(NEO),  IICAP(A),  HVDL(A),  HVR(A), 

ALO(HEO).  ArUdlEO}.  A£(NEQ},  Ah(NEO>.  I 
ACAP(NEQ).  ARESIHEO).  AINERT(NEO).  I 
V10(ME0),  VrtKHEO).  VrUCNEO),  ( 

VCAPO(NEg).  VCAP(HCa),  VRES(NEQ),  VINERT(NEO).  I  Venous  Capacitance 
PRAINEQ),  PRV(NEa),  PCAPINEO),  I  Paripitaral  Ra,  Rv,  C 


Constants 
Arterial  t  Vanous 

I  Oriantation  angle 

Arterial  I,  r,  E,  h 
Arterial  Capacitance,  resistance 
Venous  (,  r.  rUNSTRESSED 

resistance,  inertance 


PINERT(NEg),  PV«.(NEQ), 
PAO(NEa),  PVO(NEQ), 

«A0(IIEQ).  gvO(NEO), 
AVa(NEQ).  WOL(HEQ), 
PEXT(I«Q), 

TO,  6START.  GHAX,  T8XK1, 

GZ,  AOP6(ieO},  M>P6(NE0) 

A  /!/  IP,  NDXPER(HPSEG), 

ALIN<NEQ},  ALOUT(NEO), 
VLIN(NEQ),  VLOUT(HEQ), 
PIN(NEO),  POUT(NEa), 

PVS(HEa), 

IF00TSE6,  IHEAOSEG,  IHEARTSEG 
DIMENSION  POOUT(NEQ) 


TBRK2,  TMAX,  GFIN, 


Peripbarsl  I,  V 
Initial  P  conditions 
Initial  Q  conditions 
A  t  V  Volusss 

Externally  applied  Pressure 
!  G'Profile  paraswters 
Gz  t  Delta  P  froai  G 
Peripberal  Bed  Indexes 
Linkage  Data  arterial 
Venous 
Peripheral 

Ninber  parallel  venous  segacnts 
Foot,  Head,  8  Heart  seg  nuns 


c... 

c... 

c... 


Right  Heart 


PRATRN 

HP(1> 

HDP1 

PRVENT 

IIP<2) 

N0P2 

PINTHO 


PEXT(I) 

PRATRN  *  NN2PA 
1.D0*NN2PA 
HP(1)  ♦  HDP1 
PRVENT 
II.DOmOPA 
-1.0D0  *MN2PA 


presswe  for  the  pulmonary  bed 
C...  . 

C...  Left  Heart 
C... 

PLATRN  >  A.D0*MN2PA 


Right  Atrial  Pressure 
Inlet  Pressure  to  Ri^t  Atriun 
Increase  in  right  atrial  pressure 
Inlet  Pressure  to  Ri^t  Ventricular 

Increase  in  right  ventricular  pressure 
Intra-thoracic  Pressure 


I  Left  Atrial  Pressure 


!  Extramural 
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HP(S>  >  PLATRM 
NRP3  ■  4.00«MM2PA 
PLVENT  •  HP(3)  ♦  HDP3 
HP<4)  -  PLVENT 
NDP4  •>  92.00*MN2PA 


t  Left  Atrial  Inlet  Pressure 
! 

I  Left  Ventricular  Pressure 
f  Inlet  Pressure  to  LV 
I  Increase  in  LV  Pressure 


...  Ensure  pressures  are  not  less  than  external  pressures 
i  ■  1 

DO  WHILE  (  i  .LE.  NEQ  ) 

IF  (VQ(i)  .LT.  0.00)  THEN 

va<i)  a  0.00  I  Venous  valves 
END  IF 
i  a  f  ♦  1 

END  DO 

i  a  1 

DO  WHILE  (i  .LE.  3) 

V0Q<i)  a  OHAXKVOQCi),  0.00} 

i  a  i  ■»  1 

END  DO 

A0(1)  a  OMAXKAfld).  0.00)  I  No  reverse  flow  into  the  heart 
Aa(2)  a  0MAX1(AO(2),  0.00)  I  froM  arteries  or  out  of  the  heart 
HQ(1)  a  ONAXKNQd).  0.00)  I  into  veins 
NQ(3)  a  0MAX1(H0(5),  0.00) 


...  Set  the  Heart  level  G  level 


CALL  TRAPG(T0,GSrAltT,GNAX,TNAX.T8RK1,rBRK2,GFIN,T.Gz) 

e  e  e 

...  Set  peripheral  inlet  pressures  to  the  appropriate 
...  arterial  outlet  pressures 

e  e  e 

i  a  3 

00  WHILE  (  f  .LE.  HEO) 

IF(  PIN<i)  .GT.  0  )  THEN 
PP<i)  a  APdd) 

PPtd)  a  APtdd) 

END  IF 
I  a  i  ♦  1 
END  DO 


...  Coaipute  the  resistance,  capecitance  and  inertance  for  the  arterial  segments 

APdS)  a  aP<3) 
i  a  1 

DO  WHILE  (i  .LE.  HEO) 

IF  (  APd)  .LE.  PEXT(i)  )  THEN 

Ard)  a  ArU(i)  I  If  arterial  pressure  is  below  external 
END  IF  I  pressure  set  radius  to  minimus  (unstressed). 

...  rationalize  pressure,  redius,  and  capacitance. 

dPwsll  a  AP(i)  -  PEXT(i) 

IFfdPwall  .LE.  0.00)  Ar(f)  a  ArU(i) 

ACAPd)  a  3.D0*Pi*Ar(i)**3*AL0(i)/(2.00*AE(i)*Ah(i}) 
deltas  a  dPwall*ACAP(i)/(2.D0*Pi*Ar({)*AL0(i)} 

C  Ar({)  a  ArU(i)  *  deltaR 

AVOLd)  a  Pi*Ard)**2*AL0(i) 

SCALEF  a  t.oO 

IP(  i  .LE.  5  .OR.  i  .EO.  15  }  SCALEF  a  33.00 
ARESd)  a  81.DO*muO*ALO(i}/(8.DO*Pi*Ar(i)**4)*SCALEF 
AlNERT(i)  a  9.D0*rho0*AL0(i)**2/(4  DO*AVOL(i)) 

AOPGd)  a  rhoO*Gz*gO*(ZAOd )  -  ZAT(i))*OCOS(THETA(i)) 

I  a  i  ♦  1 

END  DO 
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. ..  Vcnout  rMistance,  capacitance  and  inertance  for  the  venous  segments 
i  «  1 

DO  WHILE  ({  .LE.  HEQ> 

dPtMll  >  OMAXKVPd)  -  PEXT(i),0.00} 

IF(dPtiaU  .LE.  O.DO)  Vr(i)  >  VrU(i) 

Vrmax  ■  1.333*VrU(i) 

Vr(i)  a  DMAXKVrd),  VrU(i)) 

Vr({)  a  DNINKVrd),  Vrmax) 

OPVS  a  D8LE(PVS(i)) 

VVOL(i>  a  Pi»Vr(i)**2*VL0<i> 

VRES({>  a  81.00MajO*(VLO(i)/DPVS)/(8.DO*Pi*Vr(i)**4) 

VIMERT(i)  a  9.D0*rho0*VL0({)**2/(4.00*W0L(i)) 

VDPfiii)  a  rhoO»Gr*aO»(2VO<i)  -  ZVT(i)}*OCOS(THETA(i» 

i  a  i  ♦  1 

END  DO 

CAPL  a  1.0-2  i  Capillary  Length 
I  a  1 

DO  UHILEI  i  .LE.  NPSEG) 
j  a  NDXPER(i) 

dPwall  a  OtMXKPPlj)  -  PEXT(j).  MM2PA)  I  Nin  pressure  1  irniHg 
PVOL(j)  a  PCAP(j)  •  dPiMll 

i  a  j  ♦  1 

END  DO 

OefifM  the  differential  aquations  describing  pressure,  flow,  and 
radius 

..  Pt<t)  a  1/C*(Qin(t)  •  Oout(t)}  ♦  R2/C*<0tin<t)-  Otout(t» 

..  Ot(t)  a  1/L*<Pin<t)  •  Pout(t)  ♦  PGi  •  Pext  -  R*0<t» 

..  rt<t)  a  1/(2*P{*r*l)*(ain(t)  -  Oout(t)) 


Infow  to  the  right  atrium  HQ(1)  a  V0Q(2>  *  VDQ(3) 

IF  (Va(2)  .LE.  O.DO)  VP(2)  a  hP(1) 

VOQt(2)  a  1.00/VINERT(2)*(VP(2)  •  HP(1)  ♦  VDPG(2)  !  Outflow  from  the  Superior  V.C 

-  VRES(2)*VQO(2)) 

IF  (Va(3)  .LE.  O.DO)  VP(3)  a  hP(1) 

V00t(3)  a  1.00/VINERT(3)*(VP<3)  •  HP(1)  ♦  VOPG<3)  !  Outflow  from  the  Inferior  V.C 

-  VRES<3)*V0Q(3)) 

HQt(l)  a  VOat<2)  *  V0Qt(3) 

HOfl)  a  V0Q(2)  >  V0Q(3) 


...  Right  Atriua  [Heart  Segment  1] 

H02  a  HQ(1)  •  HQ(2) 

HQ2t  a  HQt(l)  -  H0t(2} 

HR2  a  2.D-5/HCAP(1) 

HPt(l)  a  H02t*HR2  *  H02/HCAP(1) 

HPt(l)  a  O.DO 
HPt(2)  a  0.00 

HO(2)  a  (HP(1)  *  HDP1  *  MH2PA  -  HP(2))/HVR(1 ) 
HOt(2)  a  (HPt(l)  -  HPt(2))/HVR(1) 

Hat(2)  a  HQt(l) 

Ha(2)  a  HO(1) 

...  Ri^t  Ventricle  (Heart  Segment  2) 

■HQZ  a  HQ(2)  -  AQ(1) 

H02t  a  HOt(2}  •  AQt(1) 

HR2  a  2.D-5/HCAP(2) 

HPt(2)  a  NQ2t*NR2  *  HQ2/HCAP(2} 
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HPt(2)  >  O.DO 

Pulaorwry  Circulation 

Pulmnary  Artery  CArterial  Se9«ent  1] 

AOZ  ■  Afl<1)  -  pa<1) 

A02t  «  AOt(l)  •  PQtd) 

AR2  >  R2/ACAP(1) 

APt(l)  -  Aa2t*AR2  «  AQ2/ACAP(1) 

APt(l)  «  0.00 

Artd)  «  1.D0/(2.D0*Pi*Ar<1)*AL0(1))*A02 
Art(l)  -  O.DO 

AOd)  ■  (MP(2)  «  H0P2  2.D0*MM2PA  •  APd))/HVI((2) 
AQtd)  ■  (HPt(2)  -  APtd))/HVR(2) 

AOd)  >  HQ<2) 

...  Pulmnary  Capillary  Bed  (Peripheral  Segaent  1] 

POtd)  «  1.00/AINEItTd)*(APd)  -  PPd)  ♦  ADPGd) 

*  -  ARESd)*PQd)) 
pa2  «  pod)  •  vod) 

PPtd)  >  PllAd)*PQtd)  *  P02/PCAPd) 

...  Pulmnary  Veins 

votd)  ■  <pptd)  -  vptd)  •  patd)*pRAd))/PRVd) 
VQ2  «  VQd)  •  HQ(3) 
va2t  «  votd)  •  HQtO) 

VR2  a  R2/VCAPd) 

VPtd)  •  VQ2t*VR2  *■  V02/VCAPd) 
vrtd)  «  1.00/<2.00^i*Vrd)*VLOd))*V02 
Vrtd)  «  0.00 

a  a  a 

...  Left  Atriui  (Heart  Ssgmnt  3] 

HQt(3)  «  1.00/VIHERTd)*(VPd)  •  HP(3)  ♦  VOPGd) 

•  -  INI(3}*VRESd)) 

VOOtd)  «  mt(3) 

HQ2  •  m(3)  •  HQ<4) 

M2t  >  Hat(3)  •  HQt(4) 

HR2  a  2.0-5/HCAP(3} 

HPt(3)  a  HQ2t*HR2  4^  Ha2/HCAP(3) 

I9t(3)  a  O.DO 

•  •  a 

...  Left  Ventricle  (Heart  Segmnt  4] 

HQ(4)  a  (HP<3)  ♦  HOPS  ♦  2.D0*HH2PA  -  HP(4))/HVR(3) 
HQ(4)  a  Ha(3) 

H0t(4)  a  (HPt(3)  -  HPt(4))/HVR(3) 

HQt(4)  a  H0t(3) 

Ha2  a  HQ(4)  •  Aa(2) 

H02t  a  HQt(4)  •  AQC(2} 

HR2  a  2.0-S/ACAP(4) 

HPt(4)  a  ||02t*HR2  *  H02/HCAP(4) 

HPt(4)  a  0.00 

...  Ascending  Aortic  artery  (Arterial  Segment  2] 

...  AO(2)  a  (HP(4)  4^  HDP4  >  2.00n«2PA  -  AP(2))/HVR(4) 
AOt(2)  a  (HPt(4)  •  APt(2))/HVR(4) 

AQ2  a  Aa(2}  •  AO(3)  •  AOdS) 

Ai02t  a  A0t(2)  -  AOt(3)  •  AOtdS) 

AR2  a  R2/ACAP(2) 

APt(2)  a  AQ2t*AR2  ♦  A02/ACAP(2) 
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APt(2)  «  0.00 

Art(2)  >  1.DO/(2.DO*P1*Ar(2mO(2))*Aa2 
Art(2}  >  0.00 

•  •  • 

...  OMCandino  Aorta  [Artarlal  Sagwnt  3] 

AflttS)  •  1.00/AlNntT(2)*(AP<2)  -  AP(3) 

•  *  ADPG(2)  •  ARES(2)*(Aa(3>  «  AQdS)))  *  Mt(1S) 

Aa2  >  AfltS)  •  AAU)  -  PQ(3) 

A02t  «  Aat(3)  •  Aat(4)  •  Nt(3) 

AR2  s  II2/ACAPC3) 

APt(3)  >  A02t*AR2  4^  Aa2/ACAP(3) 

A0t(4)  -  1.00/AINERT(3)*(AP(3)  -  AP(4)  *  ADPG(3) 

•  -  AltES(3}*(AO(4)  4  M(3)))  -  PCIt(3) 

Art(3)  ■  1.00/{2.00*Pi*Ar<3)*AL0<3))*AQ2 
Art(3)  «  0.00 

Fora  tha  darivativoa  for  tha  other  arterial  segnents  below  the  heart. 

Thoracic  and  Cardiac  CArterial  Segment  4] 

maz  -  40(4)  •  Ao<S) 

AQ2t  >  AOt(4)  '  AOt(S) 

ARE  -  I12/ACAP(4) 

APt(4)  >  1.00/ACAP(4)*AQ2  >  Alt2*A02t 
AOt(5)  >  1.00/AIIICItT(4)*(AP(4)  •  AP(S) 

•  *  A0PG(4)  •  ARES(4)*A0(S)) 

Art(4)  >  1.00/(2.00*Pi*Ar(4)*AL0(4))*Aa2 
Art(4)  «  0.00 

a  e  a 

...  Oiaghragn  (Arterial  Segment  S] 

402  >  AQ(S)  •  AQ(6) 

AOat  >  AOt(5)  >  AOt(6) 

AR2  a  R2/ACAP(5) 

APt(5)  >  AR2*AQ2t  *  A02/ACAP(S) 

A0t(6)  >  1.00/AIiKRT<S)*<AP(5)  -  AP(6} 

•  *  ADPG(S)  •  ARES(S)*Aa(6)) 

Art(5)  >  1.00/(2.00*P(*Ar(S)»ALO(5))*Aa2 
Art(5)  >  O.DO 

...  Renal  ■  Hepatic  (Arterial  Segment  6] 

A02  -  40(6)  •  AQ(7)  •  PQ(6) 

AQ2t  >  A0t(6)  •  Aat(7)  -  PQt(6) 

AR2  ■  R2/ACAP(6) 

APt(6)  >  AR2*AQ2t  *  A02/ACAP(6) 

A0t(7}  >  1.00/AINERT(6)*(AP(6)  -  AP(7) 

•  ♦  A0P6(6)  -  ARES(6)*(Aa(7)  ♦  Pa(6)))  -  P0t(6) 

Art(6)  >  1.00/(2.00*Pi*Ar(6}*AL0(6)}*A02 

Art(6)  «  0.00 

...  Splanchnic  (Arterial  Segment  7] 

maz  •  AO(7)  -  40(8)  -  PO(7) 

402t  >  A0t(7)  •  A0t(8)  -  P0t(7) 

AR2  >  R2/ACAP(7) 

APt(7)  >  AR2*4Q2t  *  4a2/ACAP(7) 

A0t(8)  a  1.00/AINERT(7)*(AP(7)  -  AP(8) 

•  ♦  40PG(7)  -  ARES(7)*(A0(8)  ♦  PQ(7)))  -  POt(7) 

4rt(7)  »  1.00/(2.00*Pi*Ar(7)*ALO(7))*A02 

'  Art(7)  >  0.00 

...  Buttocks  (Arterial  Segment  8] 
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c.. 

c.. 

c.. 


c.. 

c.. 

c.. 


c. 

c. 

c. 


c. 

c. 

c. 


C«  •  • 

c... 


A02  >  M(8)  •  M(9)  -  PQ(8) 

A02t  >  Mt(8)  •  Mt(9)  -  PQt(8) 

AII2  -  ll2/ACAf><8) 

«Pt(8}  ■  1.00/ACAF(8)*AQ2  ♦  M2*AQ2t 
«Ot(9)  >  1.00/A1NERT(8)*(AP(8)  •  AP(9) 

•  *  ADP6(8)  •  AltES(8)*(Aa(9)  *  PQ(8»)  -  PQt<8) 
Art(8)  •  1.00/(2.0(m>{*Ar<8)*AL0(8))'*AQ2 

Art(8)  ■  O.DO 

Faaorslia  (Arterial  Segwent  9] 

A82  >  AQ(9)  •  AlQ(IO) 

AQ2t  >  AOt(9)  •  AStdO} 

AR2  -  R2/ACAP(9) 

APt(9}  «  A82*AQ2t  *  AQ2/ACAP(9) 

AOt(IO)  >  1.D0/AINERT(9)*(AP(9)  -  AP(10) 

•  ♦  Ai>P6(9)  -  ARES(9)*AO(10)) 

Art<9)  »  1.D0/(2.00*Pi*Ar<9)*AL0(9))*AO2 
Art(9)  ■  0.00 

Thigh  (Arterial  Sagaent  101 

Aa2  •  AadO)  •  Aodi)  •  podoi 
ACl2t  ■  AOtdO)  -  AiQtdl)  •  PQtdO) 

AR2  >  R2/ACAPdO} 

ARtdO)  >  AR2*AQ2t  *  AOE/ACAPdO) 

Afltdl)  -  1.00/AIIIERTdO)*(APdO)  -  APdl) 

•  ♦  AOKdO)  •  AREsdO)*(Aadi)«fadO)))  •  potdO) 
ArtdO)  >  1.00/(2.00^i*Ard0)«AL0d0))*AQ2 

ArtdO)  a  0.00 

Knee  (Arterial  Sagaant  11] 

Aa2  a  Aiodi)  •  Aad2) 

Aa2t  a  AOtdl)  '  A0td2) 

AR2  a  R2/ACARd1) 

APtdIl  a  AQ2/ACAPd1)  *  AR2*Aa2t 
AiQtd2)  a  1.00/AIIIERTd1}*(ARd1)  •  APd2) 

•  *  AORGdI)  •  ARESd1)*A0d2)) 

Artdl)  a  1.00/(2.00^i*Ard1)*ALOd1»*AQ2 
ArtdU  a  0,00 

Calf  (Arterial  Segaant  121 

Aa2  a  AQd2)  •  A0d3)  •  PQd2) 

A02t  a  Aetd2)  -  AOtdS}  •  Ntd2} 

AB9  a  B2/ACAPC12) 

APtd2)  a  AR2*AQ2t  +  Aa2/ACAPd2) 

AOtdS)  a  1.D0/AIIIERTd2}*(APd2)  -  APd3) 
a  ♦  ADPGd2)  -  ARESd2)*(AQd3)aPQd2))}  -  POtdE) 

Artd2)  a  1.00/(2.00*Pi*Ard2)*AL0d2))*Aa2 
Artd2)  a  0.00 

Ankle  (Arterial  Sagaent  131 

A02  a  A0d3}  •  AOlU) 

A02t  a  AQtd3)  -  AOtdA) 

AR2  a  R2/ACAP(13> 

APtd3)  a  A02t*AR2  *  A02/ACAI>d3) 

A0td4)  a  1.00/AINERTd3)*(ARd3)  -  APd4) 

•  *■  A0P6d3>  •  ARESd3)*AQd4)) 

Artd3)  a  1.00/(2.00aPi*Ard3)*AL0d3))*AQ2 
Artd3)  a  0.00 


Foot  (Arterial  Sagaent  14] 
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M2  -  M(U)  -  PQ(U} 

M2t  >  Mt(U)  -  Nt(U) 

M2  -  II2/ACM<H) 

MtCU)  •  All2*M2t  ♦  AB2/ACM>(14) 

Mt(U)  ■  1.00/AIIie«T<  U>*(M(H>  •  PP<U)  ♦  MP0<14) 

•  •  MKS(U)*N(14)) 

Art(14)  •  1.00/(2.0<Wi*Ar<t4)*At0<14))*M2 
Art(14)  ■  Q.DO 

c!!!  Pwlpliw*l  M  in  Foot  [Poriphoral  So0Mnt  141 
C... 

VOCU)  -  <M<14)  -  VP(14)  -  l»0<14)*P«A(14»/PRV(14) 

P02  ■  M(U)  -  VQ(14) 

PPt(14)  ■  PQt<14)*PtA<14)  ♦  PQ2/PCAP<14) 

C... 

C...  VonouB  Oroinogo  froa  Foot  tVonouo  SogMnt  14] 

c... 

Vet(U)  •  <PPt<14)  -  VPt<14)  -  P0t<14)*P*A<14))/PRV(14> 
va2  >  va<14)  -  ¥0(13) 

VQ2t  ■  vat(14)  •  vat(13) 

VII2  •  It2/VCAP(14) 

VPt(14)  >  ¥a2t*VR2  o  VQ2/VCAP(14) 

VQt(13)  ■  1.00/Vllie«T<14)*<VP<14)  -  VP<13)  ♦  V0PG{U) 

•  -  VMS(14>*V0(13)) 

Vrt(14)  •  1.00/<2.00^i*Vr<14)*VLO(14»*VQ2 

C... 

C...  Anklo  (VonoM  Sogaant  131 

POOUT<12)  ■  {PP(12)  -  WP<12)  -  P«A(12)*PQ<12))/P«V(12) 
PQQUTt  •  <PPt<12)  -  VPt<12)  •  PgA<12)*POt<12))/P«V(12) 
¥02  >  ¥0(13}  •  (¥0(12)  •  PQ0UT(12)) 

¥Q2t  ■  ¥Qt(13)  -  (¥Qt(12)  -  POOUTt) 

¥1(2  «  «t2/¥CAP(13) 

¥Pt(13)  ■  ¥02t*¥ll2  ♦  ¥Q2/VCAP(13} 

V0t(12)  •  1.00/VIIIBIT(13)*(VP(13)  -  VP(12)  ♦  ¥0PG(13> 

•  -  ¥RES(13)*(¥a(12)  -  PQ0UT(12»)  ♦  POOUTt 

Vrt(13)  «  1.00/(2.00n»l*Vr<13)*VL0(13))*¥O2 

g 

C...  Calf  C¥anouo  Sigaant.  121 

C... 

¥02  •  ¥0(12)  -  ¥0(11) 

¥a2t  -  ¥Qt(12)  -  ¥0t(11) 

¥R2  *  R2/¥CAP(12} 

¥Pt(12)  ■  ¥02t*¥«2  ♦  ¥02/¥CAP(12) 

¥Qt(11}  ■  1.00/¥igeRT(12)*{¥P(12)  •  ¥P(11)  ♦  ¥DPG(12) 

•  -  ¥ltES(12)*¥Q(11)} 

¥rt(12)  ■  1.00/(2.00*Pi*¥r(12)*VLO(12))*¥Q2 

C... 

C...  Knae  [¥anou«  Sagaent  111 

C... 

POQUT(IO)  >  (PP(IO)  -  ¥P(10)  •  PflA(10)*Pa(10)}/PR¥(10) 
POOUTt  »  (PPt(IO)  -  ¥Pt(10)  -  PRA(10)*POt(10))/PRV(10) 
¥02  «  ¥0(11)  -  (¥0(10)  -  POOUT(IO)) 

¥02t  •  ¥Ot(11)  •  (¥Ot(10)  -  POOUTt) 

¥02  «  R2/¥CAP(11) 

VPtdl)  «  ¥02t*¥R2  ♦  ¥02/VCAP(11) 

¥0t(10)  »  1.D0/¥»IERT(11)*(¥P(11)  -  ¥P(10)  ♦  VDPG(11) 

•  -  ¥RES(11)*(¥0(10)  -  POOUT(IO)))  ♦  POOUTt 

¥rt(11)  ■  1.D0/(2.00»Pf*Vr(11)*¥C0(11))*VO2 

C... 

C...  .Thigh  (Vanous  Sagaent  101 
C... 

¥02  >  ¥0(10)  •  ¥0(9) 

¥02t  «  ¥0t(10)  -  ¥Ot(9) 
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VR2  •  R2/VCAP(10) 

VPt(IO)  >  VQ2t*VR2  «  VQ2/VCAP(10) 

V0t<9)  ■  1.00/V1IK«T(10)*(VP<10)  -  VP<9)  ♦  VDM(IO) 

*  •  VI(ES(10)*VQ(9)) 

VrtdO)  •  1.00/<2.00*P<*Vr<10)*VL0(10))*VQ2 

C*  ■  • 

C...  rworalit  IVanouB  Sagamt  9] 

C... 

PQQUT(8)  ■  (P9(8)  -  VP(8)  -  PRA(8)*PQ(8))/PfiV(8) 
POOUTt  ■  <PPt<8)  -  VPt<8)  -  P«A<8)*P0t<8»/P*V(8> 
VQ2  >  ve(9)  •  (VQ(8)  -  P«]UT(8)) 

VB2t  »  Vet(9)  •  (V0t(8)  -  POOUTt) 

VR2  •  R2/VCAP(9) 

VPt(9)  ■  VQ2t*VR2  *  Va2/VCAP(9) 

VQt<8)  ■  1.00/V1M6RT(9)*<VP<9)  -  VP<8)  ♦  V0P6(9) 

*  -  VRES(9)*(Va(8)  -  PQaUT(8)))  ♦  POOUTt 
Vrt{9)  ■  1.00/(2.D(W<*Vr(9)*VL0(9))*VO2 

Ca  a  a 

Caaa  Buttoclcs  [V«nou>  SaflMftt  81 

Ca  a  a 

P0QUT<7)  ■  <PP<7)  -  VP<7)  -  PRA<7)*P0<7))/PRV{7) 
POOUTt  ■  <PPt<7)  -  WPt<7)  •  PRA<7)*POt<7))/PRV(7) 
902  >  90(8)  •  (90(7)  -  POOUT(7)) 

VQ2t  «  90t(8)  •  (90t(7)  •  POOUTt) 

VR2  -  R2/VCAP(8) 

VPt(8)  >  V02t*VR2  «  V02/9CAP(8) 

90t(7)  •  Ia00/V1IIERT(8)*(VP(8)  •  VP(7)  >  VDPfi(8) 

*  •  VRES(8)«(V0(7)  *  POOUT(7)))  *  POOUTt 

Wrt(8)  ■  1aOO/(2aOO*P<*Vr(8)*VLO(8))*V02 

Caaa 

Caaa  Splanclinfc  (9anoua  Sagnnt  71 

POOUT(6)  ■  (P9(6)  •  VP(6)  -  PRA(6)*P0(6))/PRV(6) 
POOUTt  •  (99t(6)  -  «9t(8)  -  PRR(8)*Pet(«))/PRV(8) 
902  >  90(7)  •  (90(6)  •  PQaUT(6» 

902t  -  9at(7}  •  (90t(6)  •  POOUTt) 

VR2  ■  R2/VCAP(7) 

VPt(7}  •  902t*VR2  ♦  902/9CAP(7) 

9Qt(6)  ■  1a00/VIReRT(7)*(VP(7)  -  VP(6)  ♦  W0Pe(7) 

*  -  VRES(7)*(90(6)  -  P00UT(6)))  ♦  POOUTt 

Vrt(7)  ■  1a00/(2a0<»*Pi*Vr(7)*VL0(7))*V02 

Caaa 

Caaa  Ranol  •  Hapatfc  (Vanoua  Sagaant  61 

Caaa 

902  «  90(6)  •  90(5) 

902t  ■  VOt(6)  •  V0t(5) 

VR2  •  R2/VCAP(6) 

VPt(6)  >  902t*VR2  «  VQ2/VCAP(6) 

90t(5)  ■  1a00/VIII6RT(6)*(VP(6)  -  VP(5)  ♦  V0PC{6) 

*  -  VRES(6)«VQ(5)) 

Vrt(6)  ■  1aOO/(2aOO^I*Vr(6)*VLO(6))*V02 

Caaa 

Caaa  Oiafshraon  (Venous  Sagaant  51 

Caaa 

902  >  VO(5)  -  90(4) 

Ve2t  >  VQt(5)  •  VQt(4) 

VR2  >  R2/VCAP(5) 

VPt(5)  >  902t*VR2  ♦  VQ2/VCAP(5) 

V0t(4)  ■  1aD0/VI«ERT(5)*(VP(5)  •  VP<4)  ♦  VDPW5) 

*  -  VRES(5)*9Q(4)) 

Vrt(5)  ■  laDO/(2aDO^i*Vr(5)*VLO(5))*V02 

C.aa 

Caaa  Thoracic  Circulation  (Vanoua  Sagwtnt  4) 

Caaa 

P00UT(3)  •  (PP(3)  -  VP(3)  -  PRA<3)*PO(3))/PRV(3> 
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MOUTt  •  (mta>  •  VPt(3)  •  PM(3>*Nt(3))/PRV(3) 
Vtt  •  V0(4)  •  (V0(3)  -  maUT(3)) 

VB2t  ■  V0t(4)  -  (VBt(3)  -  PMUTt) 

VR2  >  R2/VCAP(4) 

VPtC4}  >  Va2t*Vlt2  *  V02/VCA»(4) 

V0t<3>  «  1.00/VII«I»T(4>*CVP<4)  -  WP(3)  ♦  VDI>G(4) 
*  -  VIIES(4>*(VB(3>  -  PQ0UT(3)))  ♦  POOUTt 

Vrt<4>  ■  1.D0/<2.0<Wi*Vr<4)*VU0<4))*VO2 

inferior  Vono  Cava  tVanoua  Sagnant  31 

VQ2  >  V0(3)  *  V0Q(3) 
va2t  -  mt(3>  -  vc»t(3) 

VR2  -  R2/VC4P(3) 

VPt(3>  >  VQ2t*Vlt2  «  Va2/VCAP(3) 

Vrt<3)  ■  l.DO/<2.D<WI*Vr(3)*VLO<3>)*VQ2 


..  Abovo  tha  heart 

Subclavian  *  Upper  Thorax  [Arterial  Segnent  15] 

"  AP(15)  -  AP(3) 

A02  >  AQ(15)  •  AiQ(16) 

Aa2t  >  ABtdS)  •  A0t<16) 
ua  •  II2/ACAP(1S) 

APt(IS)  ■  Aa2t*AR2  ♦  AQ2/ACAP(1S) 

AOtdS)  >  1.00/AII«IT(2)*(AP(2)  -  APdS) 

•  *  ADP6(2)  •  AllES(2)*(AO(3)  ♦  AfldS)))  >  A0t(3) 
AfltdA)  -  1.00/AINaTdS)*(APd5>  <  APd6)  *  ADP6d5) 

•  •  AIIESdS)*Aa<16)} 

ArtdS)  •  1.00/<2.00*PI*Ard5)*ALOd5))*AQ2 
ArtdS)  «  0.00 

a  •  a 

...  Leuer  Neck  CArterlal  Segewnt  16] 

602  •  A«d6)  •  Aa<17) 

Aia2t  •  AOtdO)  •  AOtd7) 

AII2  «  l2/ACAPd6) 

APtd6)  >  Aia2t*AR2  ♦  AlQ2/ACAPd6) 

AQtdT)  ■  1.00/AINERTd6)*(APd6)  -  APd7) 

•  ♦  ADP«d6)  •  AIICSd6)*Aa(17)} 

Art<16)  •  1.00/<2.lKWI»Ard6)*AL0d6))«AQ2 

Artd6)  ■  0.00 

a  a  • 

...  Upper  Neck  (Carotid  sinua)  (Arterial  Segaent  171 

AQ2  -  A0d7)  •  AOdO) 

Afl2t  >  AOtd7)  •  AfltdO) 

AR2  >  RZ/ACAPdT) 

APtdT)  «  AQ2t*AR2  *  AQ2/ACAPd7) 

AQtdO)  >  1.D0/AIieilTd7)«(APd7)  •  APdO) 

•  *  A0P6d7)  •  AllESd7)*AOd8)) 

Artd7)  ■  1.00/<2.00*PI*Ard7)*AL0d7»*AO2 
ArtdT)  -  O.DO 

a  a  • 

...  Opthalnic  (Arterial  Segaent  18] 

602  >  60(18)  •  (60(19)  *  P0(18)) 

A02t  •  AOtdS)  •  (A0t(19)  *  POt(18)) 

AII2  «  R2/ACAP(18) 

-APtdS)  •  A02t*AR2  *  A02/ACAP(18) 

AOt(19)  >  1.00/AII«IT(18)*(AP(18)  •  AP(19)  ♦  A0PG(18) 

•  -  ANES(18)*(Aa(19)  ♦  PO(18)))  -  P0t(18) 

ArtdS)  *  1.D0/(2.00*PI*Ar(18)*AL0(18))*AO2 
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Art(18>  -  0.00 

C... 

C...  Nfdbrain  lArtwiat  SaoMnt  19} 

C... 

M2  -  M(19>  •  M(20) 

M2t  •  Mt(19>  -  Mt(20) 

M2  •  U!/MM(19) 

Mt(19)  -  M2t*M2  M2/ACM(19) 

Mt(20)  -  1.00/AII«(T(19)*(M<19)  •  M(20)  ♦  ADPG(19) 

•  .  MCS(19>*M<20)} 

Art(19)  ■  1.00/<2.00^«*Ar<19)*AL0<19))*AO2 
Art(19>  •  0.00 

C... 

C...  Carabral  lArtafUl  tagwant  20] 

C... 

A02  >  A0<20>  •  PQ<20) 

AQ2t  *  A0t(20)  -  POt(20) 

MO  •  R2/ACA0(20) 

A0t(20)  •  A02t*Aia  ♦  Aa2/ACA9(20) 

Art(20)  -  1.00/<2.00^1*Ar(20)*ALO(20))*AQ2 
Art(20)  *  0.00 

C... 

C...  Caratorsl  bad  (Oarfpharal  Sagaant  20] 

C... 

P0t(20)  >  1.00/AimT(20)*(AP(20)  -  P9<20)  *  AM>6(20) 

•  •  AKf(20)«N{20)) 

W0<20)  -  0NM1«Af(2O}  •  VP(20)  -  M<2O)*mA(2O»/MV(2O>,0.DO> 

N2  •  M(20)  •  m<20) 

m(20}  •  Mt(20>«mA(20)  PO2/PCAA(20) 

C... 

C...  Vanoua  Orainaea  fraa  train  ivanoua  Tagwant  20] 

C... 

V0t(20)  >  (99t(20)  •  V9t(20)  >  Mt(20)*MA<20))/f>RV(20) 

Va2  >  ¥0<20)  •  V0(19) 

V«2t  •  VQt<20)  •  ¥0t(19) 

VI2  >  R2/VCA9<20) 

V9t(20>  •  Va2t«VR2  V02/VCAP(20) 

V0t(19)  ■  1.00/V|gERT(20)*(VP<20)  -  VP<19)  ♦  V0«!<20> 

•  -  VNn(20>«VQ<19» 

Vrt<20)  ■  1.00/<2.00^l«Vr<20)«VL0(20))*VW 

C... 

C...  Nfdbrain  CVanoua  tagawnt  19] 

C... 

MOUTdt)  ■  (P9(18)  -  VP<18)  -  PgA<18)*l>0(ia»/m(18) 
raOUTt  ■  (m<18)  -  V9t(18)  -  PgA<18)*Pat(18))/PI(V(18> 

VQ2  >  VQ(19)  •  (90(18)  •  N0UT(18)) 

9a2t  >  9Qt(19)  •  (90t(18)  -  PQOUTt) 

VR2  «  II2/VCA0(19) 

V9t(19)  •  902t«V«2  *  VQ2/VCAP(19) 

V0t(18)  ■  1.00/VINggT(19)*(V9(19)  -  VP(18)  ♦  VDK!(19) 

•  -  VM8(19)*(9a(18)  -  KaUT(18))}  ■»  PQOUTt 
Vrt(19)  ■  1.00/(2.00^i«Vr(19)*VLO(19))*vq2 

C... 

C...  Opthalaric  (Vanoua  fagawnt  18] 

C... 

902  »  90(18)  •  90(17) 

902t  •  90t(18)  •  90t(17) 

902  >  t2/9CAP(18) 

9Pt(18)  >  902t<^  902/9CAP(18) 

90t(17)  •  1.00/VIIiegT(18)*(9P(18)  -  9P(17)  ♦  9DPG(18) 

•  -  9MS(18)*90(17)) 

9rt(18)  •  1.00/(2.00^i«9r(18)*9LO<18))*9Q2 

C... 

C...  Uppar  Hack  (9onoua  Sagaant  17] 

C... 
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M2  -  M(17)  •  M(16> 

M2t  •  ¥«t(17)  - 

m  •  i2/va»(i7) 

Mt(17)  •  M2t*M2  «  Vtt/VCA»(17) 

Mt(U)  •  l.#0/VIIWIT(17)*<M<17)  -  M(16)  ♦  MM(17) 

•  •  MeS(17)*M<16)) 

VrtdT)  •  1.00/<2.0(W1*Vp<17)*Vt0<17))*M2 

c*«« 

c!!!  Lomm*  Hack  (JMBlar)  [VanouB  tiM«nt 
C... 

M2  •  M(16)  •  M(15> 

M2t  >  Mt(16)  <  MtdS) 

M2  •  R27VC«7d6> 

Mtd«)  •  Va2t*M2  ♦  M2/VC«Pd6) 

MtdS)  ■  1.00/VIIW»T<16)*<M<16)  -  VPdS)  ♦  \^d6> 

•  -  MCSd6)*M<1S)) 

Vrtd6)  •  1.00/<2.0<WI«Vr<t«)*VLO<1«))*M2 

C... 

C...  fMclavtan  CWnouB  Ii0Mnt  IS] 

C... 

M2  •  M<1S)  •  M(2} 

M2t  -  MtdS)  •  Mt<2) 

M2  •  l2/VCNPdS) 

MtdS)  -  M2tnR2  •»  M2/VCMdS) 

Mt(2)  ■  1.00/VII«TdS)*<Md5)  -  M(2)  ♦  MTGdS) 

•  -  MeSdS)*M(2» 

VPt<1S)  ■  1.00/<2.00M]*VrdS)*VtOd5))*M2 

a'.V.  suparlor  Vara  Cava  CVaiMua  tipant  2] 

C... 

M2  «  M<2)  •  VM(2) 

M2t  >  «at(2)  •  V(nt<2) 

M2  «  ia/¥CM(2) 

Mt(2)  >  M2t*M2  ♦  M2/VCM(2) 

Vrt(2)  •  1.00/(2.00M<*Vr<2)*Vl0<2))*M2 

C... 

C...  fora  tlw  dtpivativaa  for  ttio  pariphoral  badt 
C... 

C...  Optlwlafe  (Tariphorol  Sogaant  18] 

C... 

M2  •  N<18)  *  NOUTdS) 

MtdS)  •  Mtd8)/PM<18)  •  M2/(MAd8)*KAP<18)) 

C... 

C...  Thorax  and  Coronarlaa  tParlpharal  Sasatnt  3] 

C... 

M2  >  M<3)  •  PQQUT(3) 

Mt(3)  •  P7t<3)/P1»<3)  -  PQ2/<PM<3)*PCA0<3)) 

C... 

C...  taaBlndor  of  Mrlpharal  Sogaanta 
C... 

f  •  6 

go  WNILEd  .LE.  iraOTSEfi  •  1) 

IF  (  MUTd)  .6T.  0  )  THEN 
p«2  •  Md)  •  paauT<i) 

Mtd)  ■  Mtd)/MAd)  -  M2/{P«Ad)*FCAI»<1)) 
END  IF 
I  *  1  ♦  1 
BB  M 
RETURN 
END 

gURROUTINE  MINT(NI,N06,  N07,  NOB) 

C...  • 

CRmg  CflMMOII 
C... 

C...  /Y/ tiaa  varfablaa 
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/F/  tlw  drrlvatlvw  of  vorlabloo 
l%t  opot**!  dM-ivotlvw  of  varfaMos 

/R/  ft  /I/  root  and  intoRor  par—tara  raqMirad  to  daf<na  conatanta  and 
daftna  tha  apatlal  intagratlon  grid. 

IMPLICIT  0QUM.C  PMECISIQN  <A-H.  0-Z) 

PARAMETn  (NCO  ■  20,  UPfCO  ■  10) 

INTffifR  MSTOP,  MMM,  IP 

lllttaER*2  ALIN,  ALOUT,  VLIM,  VUMT,  PVS.  PIN,  POUT 
OOUMJ  PRfCItlON  WOPA,  aadi,  PPbadfNEO) 

OONRM/T/  T,  NSTOP,  NORUN  I  Run  Paraatttara 

a  •  a 

...  Arraya  for  aagawital  variaMaa  Praaaura  (P).  FtoiKO),  and  radii  (r) 


1 

m  RPU), 

MRU), 

1  Heart's  Chaabers  RAal 

• 

AP(NEO), 

AOfNEO), 

Ar(NEO), 

1  Arterial  P,  Q,  r 

• 

VPINEG), 

VG<NEO), 

Vr<NEQ). 

1  Vanoua  P,  o,  r 

• 

VOPfS), 

VW(3), 

1  Vanous  flows  into  heart 

• 

PP(NEO), 

PQ(NEQ), 

1  Peripheral  P,  Gin,  Gout 

Ti 

Ian  darivetivaa 

of  the  aagNantal  variables:  Pt,  ot,  rt 

2 

/F/  NPtU), 

NQtU), 

1  Heart's  Chaabers  RA*1 

• 

APtfHEO), 

AOt(MEQ). 

Art(NEQ), 

I  Arterial  Pt,  Gt,  rt 

• 

VPt(NEO), 

VQt(NEQ), 

Vrt(NEQ), 

1  Vanous  Pt,  Gt,  rt 

* 

VOPttS), 

VQ0t(3), 

1  Vanous  flows  into  heart 

• 

PPtlNEO), 

POtiHEO), 

1  Peripheral  Pt,  GINt,  GOUTt 

Paraaatars  naeaaaary  to  fona  tha  diffarantial  oquationa 


Pi  •  3.U159... 

•0  *  9.806d5  0i^aac*21  aarch'a  aeealaration  of  sravity 

rtioO  •  1080.  tka/arsi  danaity  of  hNoIo  Mood  USX  Net)  |  Aaauaad 

aaO  *  2.7  tcpl  viaeoaity  of  uhola  Mood  USX  Net)!  Conatant 

02R  *  pi/100  (radlana/dapraa)  aeala  factor 


S  /R/  Pi,  gO.  rlMO,  aaiO,  D2R,  igi2PA,  R2, 

2A0(HM),  ZATdKO),  ZVOfNEO),  ZVT(HEQ), 
THCTAdKQ),  NCAPU),  IRIQLU).  HVRU), 
ALO(NEQ),  ArUCNCQ),  ACfNEQ),  AA(IIEO), 
ACAP(REQ),  ARES(ICQ),  AINERT(HEQ). 

VLO(NN),  VrOCICQ).  VrtKREQ). 

VCMPOfNEQ),  VCAPCHEa).  yRCOfNEO), 

PRA(HEQ),  PRYfREO),  PCAP(NEO), 

PIHERT(NEa),  PYOKHEO), 

PAOCMEQ),  PVOfNEQ), 

QAO(NEO),  ONOTNEQ), 

AVaCNEQ),  WOL(NEQ), 

PEXTCNEO), 

TO,  ORTART,  RNAX,  TRRKI,  TRRICZ.  TNAX,  GFIN, 
OS,  AOPG(NEQ),  VDPg<NEQ) 

4  /!/  IP,  RMPERtHPSEO), 

ALIN(NEQ),  ALOUT(NEQ), 

VLINfNEQ),  VLOUrfHEO), 

PIN(NEO),  PQUT(NEQ), 

PVKHEQ), 

IFOOrSEG,  INEA0SE6,  IHEARTSEG 


i  Conatanta 
I  Arterial  ft  Vanoua 

I  Oriantaticn  angle 

I  Arterial  I,  r,  E,  h 
I  Arterial  Capacitance,  resistance 
I  Venous  I,  r,  rUNSTRESSED 

VINERT(NEO),  I  Vanous  Capacitance,  reaiatance,  inertance 
I  Peripheral  Ra,  Rv,  C 
Peripheral  I,  V 
Initial  P  co^itiora 
Initial  Q  conditions 
A  ft  V  Voluasa 

Externally  applied  Pressure 
I  G-Profile  paraaietera 
6z  ft  Delta  P  froai  6 
Peripheral  Bed  Indexes 
Linkage  Data  arterial 
Venous 
Peripheral 

I  NuPber  parallel  venous  segoKnts 
I  Foot,  Head,  ft  Heart  seg  nuas 


I 


...  PRINT  A  HEADING  FOR  THE  NUMERICAL  SOLUTION 
IP-IPel 

IF(IP.N.1)URITE(N06,100) 

IF(lP.Eg.1>URITE(N07,100) 

I F( IP .EO. 1 )MIITE(NQe, 100) 
IFdP.EO.DURITEfM) 
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u  u  u  u  u 


Program  CVSUBS.FOR 


WITKHO.Z} 

wmtdo.Z)  T 

1  FOMMTtZX.'T  •  ',F12.*,'  •«'  ) 

I!!  MINT  TIC  nuniQN 

HCKD  >  MXKZ)  VOO(5) 

Wine  *,Z2)  T,  St.  TI«TA<1).<VP<k>,  k-I.NCQ),  (VO(k),  k-1,HEO) 
laiTEC  *,2Z>  T,  fix,  TIKTA(1),(Hr(k).  k«1,4),  (MQCk).  k«1,4) 
WITE(M6.Z)  T.  Os,  TI«TA<1),<Ar<k),  k-I.NEO),  (AO(k).  k»l,NEO> 
yRITE(ll07,Z>  T.  Os,  TIIETA(1),(VP<k),  k-I.HEQ),  (VOCk),  k«1.HEO) 
f  -  1 

DO  MILE  (<  .LE.  NES) 

MtoMCO  •  M<l)  -  M<0*MA<i) 
f  ■  f  ♦  1 
OO  DO 

M1TE(N0S,2)  T,  Gz.  TMETA<1),<MbM<k),  k>1.NEO).(M(k},  k>1,MEO) 
Z  RMNAT(3F8.4.60(E1Z.4.1X)) 

22  FQItNAT(1X.3Fa.4,  /,12(5<E12.4,1X),1X,/)) 

too  FONNAKZX,'  TI«t',3X,'  Os  Th«t«  ','Op  Art  , 

*»  Op  Art  FIom',»  Op  Vn  Op  Vn  FIom'.'Op  PM  Pr  ') 

RETUm 

END 
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